pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

lazMapViewer: Remove dependence on synapse

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6308 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-04-16 15:15:27 +00:00
parent c76a4f904a
commit 60e3e16e2d
9 changed files with 313 additions and 165 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
components/lazmapviewer/example/main.lfm
View File

@ -4,5 +4,36 @@ object Form1: TForm1
Top = 127 Top = 127
Width = 869 Width = 869
Caption = 'Form1' Caption = 'Form1'
ClientHeight = 545
ClientWidth = 869
OnCreate = FormCreate
OnShow = FormShow
LCLVersion = '1.9.0.0' LCLVersion = '1.9.0.0'
object Panel1: TPanel
Left = 632
Height = 545
Top = 0
Width = 237
Align = alRight
Caption = 'Panel1'
TabOrder = 0
end
object MapView1: TMapView
Left = 0
Height = 545
Top = 0
Width = 632
Active = False
Align = alClient
CacheOnDisk = True
CachePath = 'cache/'
InactiveColor = clWhite
MapProvider = 'OpenStreetMap Mapnik'
UseThreads = True
Zoom = 0
end
object GeoNames: TMVGeoNames
left = 481
top = 256
end
end end

26
components/lazmapviewer/example/main.pas
View File

@ -5,13 +5,19 @@ unit Main;
interface interface
uses uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls; Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, mvgeonames,
mvMapViewer;
type type
{ TForm1 } { TForm1 }
TForm1 = class(TForm) TForm1 = class(TForm)
MapView1: TMapView;
GeoNames: TMVGeoNames;
Panel1: TPanel;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
private private
public public
@ -25,5 +31,23 @@ implementation
{$R *.lfm} {$R *.lfm}
uses
mvTypes;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
MapView1.DoubleBuffered := true;
MapView1.Zoom := 7;
GeoNames.LocationName := 'New York';
MapView1.Center := GeoNames.Search(MapView1.DownloadEngine);
end;
procedure TForm1.FormShow(Sender: TObject);
begin
MapView1.Active := true;
end;
end. end.

62
components/lazmapviewer/lazmapviewerpkg.lpk
View File

@ -16,69 +16,63 @@
<UnitName Value="mvCache"/> <UnitName Value="mvCache"/>
</Item1> </Item1>
<Item2> <Item2>
<Filename Value="source/mvdlesynapse.pas"/>
<UnitName Value="mvDLESynapse"/>
</Item2>
<Item3>
<Filename Value="source/mvdownloadengine.pas"/> <Filename Value="source/mvdownloadengine.pas"/>
<UnitName Value="mvDownloadEngine"/> <UnitName Value="mvDownloadEngine"/>
</Item3> </Item2>
<Item4> <Item3>
<Filename Value="source/mvdragobj.pas"/> <Filename Value="source/mvdragobj.pas"/>
<UnitName Value="mvdragobj"/> <UnitName Value="mvdragobj"/>
</Item4> </Item3>
<Item5> <Item4>
<Filename Value="source/mvengine.pas"/> <Filename Value="source/mvengine.pas"/>
<UnitName Value="mvEngine"/> <UnitName Value="mvEngine"/>
</Item5> </Item4>
<Item6> <Item5>
<Filename Value="source/mvgeonames.pas"/> <Filename Value="source/mvgeonames.pas"/>
<HasRegisterProc Value="True"/> <HasRegisterProc Value="True"/>
<UnitName Value="mvgeonames"/> <UnitName Value="mvGeoNames"/>
</Item6> </Item5>
<Item7> <Item6>
<Filename Value="source/mvgpsobj.pas"/> <Filename Value="source/mvgpsobj.pas"/>
<UnitName Value="mvgpsobj"/> <UnitName Value="mvgpsobj"/>
</Item7> </Item6>
<Item8> <Item7>
<Filename Value="source/mvjobqueue.pas"/> <Filename Value="source/mvjobqueue.pas"/>
<UnitName Value="mvJobQueue"/> <UnitName Value="mvJobQueue"/>
</Item8> </Item7>
<Item9> <Item8>
<Filename Value="source/mvjobs.pas"/> <Filename Value="source/mvjobs.pas"/>
<UnitName Value="mvJobs"/> <UnitName Value="mvJobs"/>
</Item9> </Item8>
<Item10> <Item9>
<Filename Value="source/mvmapprovider.pas"/> <Filename Value="source/mvmapprovider.pas"/>
<UnitName Value="mvMapProvider"/> <UnitName Value="mvMapProvider"/>
</Item10> </Item9>
<Item11> <Item10>
<Filename Value="source/mvtypes.pas"/> <Filename Value="source/mvtypes.pas"/>
<UnitName Value="mvtypes"/> <UnitName Value="mvtypes"/>
</Item11> </Item10>
<Item12> <Item11>
<Filename Value="source/mvmapviewer.pas"/> <Filename Value="source/mvmapviewer.pas"/>
<HasRegisterProc Value="True"/> <HasRegisterProc Value="True"/>
<UnitName Value="mvmapviewer"/> <UnitName Value="mvmapviewer"/>
</Item12> </Item11>
<Item13> <Item12>
<Filename Value="source/mvextradata.pas"/> <Filename Value="source/mvextradata.pas"/>
<UnitName Value="mvextradata"/> <UnitName Value="mvextradata"/>
</Item12>
<Item13>
<Filename Value="source/mvdlefpc.pas"/>
<UnitName Value="mvDLEFpc"/>
</Item13> </Item13>
</Files> </Files>
<RequiredPkgs Count="4"> <RequiredPkgs Count="2">
<Item1> <Item1>
<PackageName Value="laz_synapse"/> <PackageName Value="LCLBase"/>
</Item1> </Item1>
<Item2> <Item2>
<PackageName Value="rgb_graphics"/>
</Item2>
<Item3>
<PackageName Value="LCLBase"/>
</Item3>
<Item4>
<PackageName Value="FCL"/> <PackageName Value="FCL"/>
</Item4> </Item2>
</RequiredPkgs> </RequiredPkgs>
<UsageOptions> <UsageOptions>
<UnitPath Value="$(PkgOutDir)"/> <UnitPath Value="$(PkgOutDir)"/>

10
components/lazmapviewer/lazmapviewerpkg.pas
View File

@ -8,20 +8,18 @@ unit lazMapViewerPkg;
interface interface
uses uses
mvCache, mvDLESynapse, mvDownloadEngine, mvDragObj, mvEngine, mvGeoNames, mvCache, mvDownloadEngine, mvdragobj, mvEngine, mvGeoNames, mvgpsobj,
mvGPSObj, mvJobQueue, mvJobs, mvMapProvider, mvTypes, mvMapViewer, mvJobQueue, mvJobs, mvMapProvider, mvtypes, mvmapviewer, mvextradata,
mvExtraData, mvDLEFpc, LazarusPackageIntf;
LazarusPackageIntf;
implementation implementation
procedure Register; procedure Register;
begin begin
RegisterUnit('mvgeonames', @mvgeonames.Register); RegisterUnit('mvGeoNames', @mvGeoNames.Register);
RegisterUnit('mvmapviewer', @mvmapviewer.Register); RegisterUnit('mvmapviewer', @mvmapviewer.Register);
end; end;
initialization initialization
RegisterPackage('lazMapViewerPkg', @Register); RegisterPackage('lazMapViewerPkg', @Register);
end. end.

83
components/lazmapviewer/source/mvdlefpc.pas Normal file
View File

@ -0,0 +1,83 @@
{ Map Viewer Download Engine Free Pascal HTTP Client
Copyright (C) 2011 Maciej Kaczkowski / keit.co
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
Taken from:
https://forum.lazarus.freepascal.org/index.php/topic,12674.msg160255.html#msg160255
}
unit mvDLEFpc;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes,
mvDownloadEngine;
type
{ TMVDEFPC }
TMVDEFPC = class(TMvCustomDownloadEngine)
protected
procedure DownloadFile(const Url: string; str: TStream); override;
{$IF FPC_FullVersion >= 30101}
published
property UseProxy;
property ProxyHost;
property ProxyPort;
property ProxyUsername;
property ProxyPassword;
{$ENDIF}
end;
implementation
uses
fphttpclient;
{ TMVDEFPC }
procedure TMVDEFPC.DownloadFile(const Url: string; str: TStream);
var
http: TFpHttpClient;
begin
inherited;
http := TFpHttpClient.Create(nil);
try
http.AllowRedirect := true;
http.AddHeader('User-Agent','Mozilla/5.0 (compatible; fpweb)');
{$IF FPC_FullVersion >= 30101}
if UseProxy then begin
http.Proxy.Host := ProxyHost;
http.Proxy.Port := ProxyPort;
http.Proxy.UserName := ProxyUserName;
http.Proxy.Password := ProxyPassword;
end;
{$ENDIF}
http.Get(Url, str);
str.Position := 0;
finally
http.Free;
end;
end;
end.

13
components/lazmapviewer/source/mvdownloadengine.pas
View File

@ -24,20 +24,21 @@ interface
uses uses
Classes, SysUtils; Classes, SysUtils;
Type
{ TCustomDownloadEngine } type
TCustomDownloadEngine = class(TComponent) { TMvCustomDownloadEngine }
TMvCustomDownloadEngine = class(TComponent)
public public
procedure DownloadFile(const Url: string; str: TStream); virtual; procedure DownloadFile(const Url: string; AStream: TStream); virtual;
end; end;
implementation implementation
{ TCustomDownloadEngine } { TMvCustomDownloadEngine }
procedure TCustomDownloadEngine.DownloadFile(const Url: string; str: TStream); procedure TMvCustomDownloadEngine.DownloadFile(const Url: string; AStream: TStream);
begin begin
end; end;

96
components/lazmapviewer/source/mvengine.pas
View File

@ -26,8 +26,8 @@ unit mvEngine;
interface interface
uses uses
Classes, SysUtils,mvJobQueue,mvmapprovider,mvDownloadEngine,IntfGraphics, Classes, SysUtils, IntfGraphics, Controls,
mvCache,mvdragobj,controls,mvtypes; mvTypes, mvJobQueue, mvMapProvider, mvDownloadEngine, mvCache, mvDragObj;
const const
EARTH_RADIUS = 6378137; EARTH_RADIUS = 6378137;
@ -62,7 +62,7 @@ Type
DragObj : TDragObj; DragObj : TDragObj;
Cache : TPictureCache; Cache : TPictureCache;
FActive: boolean; FActive: boolean;
FDownloadEngine: TCustomDownloadEngine; FDownloadEngine: TMvCustomDownloadEngine;
FDrawTitleInGuiThread: boolean; FDrawTitleInGuiThread: boolean;
FOnCenterMove: TNotifyEvent; FOnCenterMove: TNotifyEvent;
FOnChange: TNotifyEvent; FOnChange: TNotifyEvent;
@ -86,7 +86,8 @@ Type
procedure SetActive(AValue: boolean); procedure SetActive(AValue: boolean);
procedure SetCacheOnDisk(AValue: Boolean); procedure SetCacheOnDisk(AValue: Boolean);
procedure SetCachePath(AValue: String); procedure SetCachePath(AValue: String);
procedure SetDownloadEngine(AValue: TCustomDownloadEngine); procedure SetCenter(aCenter: TRealPoint);
procedure SetDownloadEngine(AValue: TMvCustomDownloadEngine);
procedure SetHeight(AValue: integer); procedure SetHeight(AValue: integer);
procedure SetMapProvider(AValue: String); procedure SetMapProvider(AValue: String);
procedure SetUseThreads(AValue: Boolean); procedure SetUseThreads(AValue: Boolean);
@ -113,52 +114,59 @@ Type
Procedure DoDrag(Sender : TDragObj); Procedure DoDrag(Sender : TDragObj);
public public
Procedure CancelCurrentDrawing; constructor Create(aOwner : TComponent);override;
Procedure Redraw;
function AddMapProvider(OpeName: String; Url: String; MinZoom : integer;MaxZoom : integer;NbSvr: integer; GetSvrStr: TGetSvrStr =nil; GetXStr: TGetValStr =nil; GetYStr: TGetValStr =nil; GetZStr: TGetValStr =nil) : TMapProvider;
Procedure GetMapProviders(lst : TStrings);
Constructor Create(aOwner : TComponent);override;
destructor Destroy; override; destructor Destroy; override;
Function ScreenToLonLat(aPt : TPoint) : TRealPoint;
Function LonLatToScreen(aPt : TRealPoint) : TPoint;
Function WorldScreenToLonLat(aPt : TPoint) : TRealPoint;
Function LonLatToWorldScreen(aPt : TRealPoint) : TPoint;
Procedure SetSize(aWidth,aHeight : integer); procedure CancelCurrentDrawing;
procedure Redraw;
function AddMapProvider(OpeName: String; Url: String; MinZoom : integer;MaxZoom : integer;NbSvr: integer; GetSvrStr: TGetSvrStr =nil; GetXStr: TGetValStr =nil; GetYStr: TGetValStr =nil; GetZStr: TGetValStr =nil) : TMapProvider;
procedure GetMapProviders(lst: TStrings);
Procedure MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer); function ScreenToLonLat(aPt: TPoint): TRealPoint;
Procedure MouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer); function LonLatToScreen(aPt: TRealPoint): TPoint;
Procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); function WorldScreenToLonLat(aPt: TPoint): TRealPoint;
Procedure DblClick(Sender: TObject); function LonLatToWorldScreen(aPt: TRealPoint): TPoint;
Procedure MouseWheel(Sender: TObject; Shift: TShiftState;WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
Procedure SetCenter(aCenter : TRealPoint);
Procedure ZoomOnArea(const aArea : TRealArea);
procedure SetSize(aWidth, aHeight: integer);
procedure DblClick(Sender: TObject);
procedure MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint; var Handled: Boolean);
procedure ZoomOnArea(const aArea : TRealArea);
property Center : TRealPoint read GetCenter write SetCenter; property Center : TRealPoint read GetCenter write SetCenter;
property Zoom : integer read GetZoom write SetZoom;
property Width : integer read GetWidth write SetWidth; published
property Height : integer read GetHeight write SetHeight; property Active : boolean read FActive write SetActive default false;
property UseThreads : Boolean read GetUseThreads write SetUseThreads;
property MapProvider : String read GetMapProvider write SetMapProvider;
property DownloadEngine : TCustomDownloadEngine read FDownloadEngine write SetDownloadEngine;
property CacheOnDisk : Boolean read GetCacheOnDisk write SetCacheOnDisk; property CacheOnDisk : Boolean read GetCacheOnDisk write SetCacheOnDisk;
property CachePath : String read GetCachePath write SetCachePath; property CachePath : String read GetCachePath write SetCachePath;
property Active : boolean read FActive write SetActive; property DownloadEngine : TMvCustomDownloadEngine read FDownloadEngine write SetDownloadEngine;
property DrawTitleInGuiThread : boolean read FDrawTitleInGuiThread write FDrawTitleInGuiThread;
property Height : integer read GetHeight write SetHeight;
property MapProvider : String read GetMapProvider write SetMapProvider;
property UseThreads : Boolean read GetUseThreads write SetUseThreads;
property Width : integer read GetWidth write SetWidth;
property Zoom : integer read GetZoom write SetZoom;
property OnDrawTile :TDrawTileEvent read FOnDrawTile write FOnDrawTile; property OnDrawTile :TDrawTileEvent read FOnDrawTile write FOnDrawTile;
property DrawTitleInGuiThread : boolean read FDrawTitleInGuiThread write FDrawTitleInGuiThread;
property OnCenterMove : TNotifyEvent read FOnCenterMove write FOnCenterMove; property OnCenterMove : TNotifyEvent read FOnCenterMove write FOnCenterMove;
property OnZoomChange : TNotifyEvent read FOnZoomChange write FOnZoomChange; property OnZoomChange : TNotifyEvent read FOnZoomChange write FOnZoomChange;
property Jobqueue : TJobQueue read Queue; property Jobqueue : TJobQueue read Queue;
property OnChange : TNotifyEvent Read FOnChange write FOnchange; //called when visiable area change property OnChange : TNotifyEvent Read FOnChange write FOnchange; //called when visiable area change
End; end;
implementation implementation
uses Math,mvJobs,forms,mvgpsobj;
Type uses
Math, Forms,
mvJobs, mvGpsObj;
type
{ TLaunchDownloadJob } { TLaunchDownloadJob }
@ -348,10 +356,10 @@ end;
procedure TMapViewerEngine.SetCachePath(AValue: String); procedure TMapViewerEngine.SetCachePath(AValue: String);
begin begin
Cache.BasePath:=aValue; Cache.BasePath := aValue;
end; end;
procedure TMapViewerEngine.SetDownloadEngine(AValue: TCustomDownloadEngine); procedure TMapViewerEngine.SetDownloadEngine(AValue: TMvCustomDownloadEngine);
begin begin
if FDownloadEngine=AValue then Exit; if FDownloadEngine=AValue then Exit;
FDownloadEngine:=AValue; FDownloadEngine:=AValue;
@ -395,7 +403,7 @@ end;
function TMapViewerEngine.GetWidth: integer; function TMapViewerEngine.GetWidth: integer;
begin begin
Result:=MapWin.Width Result := MapWin.Width
end; end;
function TMapViewerEngine.ScreenToLonLat(aPt: TPoint): TRealPoint; function TMapViewerEngine.ScreenToLonLat(aPt: TPoint): TRealPoint;
@ -822,8 +830,10 @@ begin
FActive:=AValue; FActive:=AValue;
if not(FActive) then if not(FActive) then
Queue.CancelAllJob(self) Queue.CancelAllJob(self)
else else begin
Redraw(MapWin); if Cache.UseDisk then ForceDirectories(Cache.BasePath);
Redraw(MapWin);
end;
end; end;
procedure TMapViewerEngine.DoDrag(Sender: TDragObj); procedure TMapViewerEngine.DoDrag(Sender: TDragObj);
@ -902,13 +912,15 @@ constructor TMapViewerEngine.Create(aOwner: TComponent);
begin begin
DrawTitleInGuiThread := true; DrawTitleInGuiThread := true;
DragObj := TDragObj.Create; DragObj := TDragObj.Create;
DragObj.OnDrag:=@DoDrag; DragObj.OnDrag := @DoDrag;
Cache := TPictureCache.Create(self); Cache := TPictureCache.Create(self);
lstProvider:=TStringList.Create; lstProvider := TStringList.Create;
RegisterProviders; RegisterProviders;
Queue:=TJobQueue.Create(8); Queue := TJobQueue.Create(8);
Queue.OnIdle:= @Cache.CheckCacheSize; Queue.OnIdle := @Cache.CheckCacheSize;
inherited Create(aOwner); inherited Create(aOwner);
ConstraintZoom(MapWin); ConstraintZoom(MapWin);
CalculateWin(mapWin); CalculateWin(mapWin);
end; end;

44
components/lazmapviewer/source/mvgeonames.pas
View File

@ -38,9 +38,10 @@ type
FOnNameFound: TNameFoundEvent; FOnNameFound: TNameFoundEvent;
function RemoveTag(const str: String): TStringArray; function RemoveTag(const str: String): TStringArray;
public public
function DoSearch(dl : TCustomDownloadEngine): TRealPoint; function Search(ALocationName: String;
ADownloadEngine: TMvCustomDownloadEngine): TRealPoint;
published published
property LocationName: string read FLocationName write FLocationName; property LocationName: string read FLocationName;
property OnNameFound : TNameFoundEvent read FOnNameFound write FOnNameFound; property OnNameFound : TNameFoundEvent read FOnNameFound write FOnNameFound;
end; end;
@ -110,7 +111,8 @@ Begin
end; end;
function TMVGeoNames.DoSearch(dl: TCustomDownloadEngine): TRealPoint; function TMVGeoNames.Search(ALocationName: String;
ADownloadEngine: TMvCustomDownloadEngine): TRealPoint;
const const
LAT_ID = '<span class="latitude">'; LAT_ID = '<span class="latitude">';
LONG_ID = '<span class="longitude">'; LONG_ID = '<span class="longitude">';
@ -128,7 +130,7 @@ var
while (s[i] <> '<') and (i < ln) do while (s[i] <> '<') and (i < ln) do
begin begin
if s[i] = '.' then if s[i] = '.' then
Result := Result + DecimalSeparator Result := Result + FormatSettings.DecimalSeparator
else else
Result := Result + s[i]; Result := Result + s[i];
Inc(i); Inc(i);
@ -142,9 +144,10 @@ var
iStartDescr : integer; iStartDescr : integer;
lst : TStringArray; lst : TStringArray;
begin begin
FLocationName := ALocationName;
m := TMemoryStream.Create; m := TMemoryStream.Create;
try try
dl.DownloadFile('http://www.geonames.org/search.html?q='+ ADownloadEngine.DownloadFile('http://www.geonames.org/search.html?q='+
CleanLocationName(FLocationName), m); CleanLocationName(FLocationName), m);
m.Position := 0; m.Position := 0;
SetLength(s, m.Size); SetLength(s, m.Size);
@ -154,44 +157,43 @@ begin
end; end;
Result.Lon := 0; Result.Lon := 0;
Result.Lat:=0; Result.Lat := 0;
SetLength(lstRes,0); SetLength(lstRes, 0);
iRes:=Pos('<span class="geo"',s); iRes := Pos('<span class="geo"',s);
while (iRes>0) do while (iRes>0) do
Begin begin
SetLength(lstRes,length(lstRes)+1); SetLength(lstRes,length(lstRes)+1);
lstRes[high(lstRes)].Loc.Lon:=strtofloat(gs(LONG_ID,iRes)); lstRes[high(lstRes)].Loc.Lon := StrToFloat(gs(LONG_ID,iRes));
lstRes[high(lstRes)].Loc.Lat:=strtofloat(gs(LAT_ID,iRes)); lstRes[high(lstRes)].Loc.Lat := StrToFloat(gs(LAT_ID,iRes));
iStartDescr:=RPosex('<td>',s,iRes); iStartDescr := RPosex('<td>',s,iRes);
if iStartDescr>0 then if iStartDescr>0 then
Begin begin
lst:=RemoveTag(Copy(s,iStartDescr,iRes-iStartDescr)); lst:=RemoveTag(Copy(s,iStartDescr,iRes-iStartDescr));
if length(lst)>0 then if length(lst)>0 then
lstRes[high(lstRes)].Name:=lst[0]; lstRes[high(lstRes)].Name:=lst[0];
lstRes[high(lstRes)].Descr:=''; lstRes[high(lstRes)].Descr:='';
For i:=1 to high(lst) do for i:=1 to high(lst) do
lstRes[high(lstRes)].Descr+=lst[i]; lstRes[high(lstRes)].Descr+=lst[i];
end; end;
Result.Lon += lstRes[high(lstRes)].Loc.Lon; Result.Lon += lstRes[high(lstRes)].Loc.Lon;
Result.Lat += lstRes[high(lstRes)].Loc.Lat; Result.Lat += lstRes[high(lstRes)].Loc.Lat;
iRes:=PosEx('<span class="geo"',s,iRes+17); iRes := PosEx('<span class="geo"',s,iRes+17);
End; end;
if length(lstRes)>0 then if length(lstRes)>0 then
Begin begin
if length(lstRes)>1 then if length(lstRes)>1 then
begin begin
Result.Lon := Result.Lon/length(lstRes); Result.Lon := Result.Lon/length(lstRes);
Result.Lat := Result.Lat/length(lstRes); Result.Lat := Result.Lat/length(lstRes);
end; end;
if Assigned(FOnNameFound) then if Assigned(FOnNameFound) then
For iRes:=low(lstRes) to high(lstRes) do for iRes:=low(lstRes) to high(lstRes) do
Begin begin
FOnNameFound(lstRes[iRes].Name,lstRes[iRes].Descr,lstRes[iRes].Loc); FOnNameFound(lstRes[iRes].Name,lstRes[iRes].Descr,lstRes[iRes].Loc);
end; end;
End; end;
end; end;
end. end.

113
components/lazmapviewer/source/mvmapviewer.pas
View File

@ -35,7 +35,7 @@ uses
Classes, SysUtils, Controls, Graphics, IntfGraphics, Classes, SysUtils, Controls, Graphics, IntfGraphics,
{$IFDEF USE_RGBGRAPHICS}RGBGraphics,{$ENDIF} {$IFDEF USE_RGBGRAPHICS}RGBGraphics,{$ENDIF}
{$IFDEF USE_LAZINTFIMAGE}FPCanvas,{$ENDIF} {$IFDEF USE_LAZINTFIMAGE}FPCanvas,{$ENDIF}
MvTypes, MvGPSObj, MvEngine, MvMapProvider, MVDLESynapse; MvTypes, MvGPSObj, MvEngine, MvMapProvider, MvDownloadEngine;
Type Type
@ -43,10 +43,10 @@ Type
TMapView = class(TCustomControl) TMapView = class(TCustomControl)
private private
dl : TMVDESynapse; FDownloadEngine: TMvCustomDownloadEngine;
FEngine : TMapViewerEngine; FEngine: TMapViewerEngine;
{$IFDEF USE_RGBGRAPHICS} {$IFDEF USE_RGBGRAPHICS}
Buffer : TRGB32Bitmap; Buffer: TRGB32Bitmap;
{$ENDIF} {$ENDIF}
{$IFDEF USE_LAZINTFIMAGE} {$IFDEF USE_LAZINTFIMAGE}
Buffer: TLazIntfImage; Buffer: TLazIntfImage;
@ -112,6 +112,7 @@ Type
procedure ZoomOnObj(obj: TGPSObj); procedure ZoomOnObj(obj: TGPSObj);
procedure WaitEndOfRendering; procedure WaitEndOfRendering;
property Center: TRealPoint read GetCenter write SetCenter; property Center: TRealPoint read GetCenter write SetCenter;
property DownloadEngine: TMvCustomDownloadEngine read FDownloadEngine;
property Engine: TMapViewerEngine read FEngine; property Engine: TMapViewerEngine read FEngine;
property GPSItems: TGPSObjectList read FGPSItems; property GPSItems: TGPSObjectList read FGPSItems;
published published
@ -140,11 +141,13 @@ Type
procedure Register; procedure Register;
implementation implementation
uses uses
{$IFDEF USE_LAZINTFIMAGE} {$IFDEF USE_LAZINTFIMAGE}
Math, FPImgCanv, FPImage, LCLVersion, Math, FPImgCanv, FPImage, LCLVersion,
{$ENDIF} {$ENDIF}
GraphType, mvjobqueue, mvextradata, LResources; LResources,
GraphType, mvJobQueue, mvExtraData, mvDLEFpc;
procedure Register; procedure Register;
begin begin
@ -286,18 +289,18 @@ end;
function TDrawObjJob.Running: boolean; function TDrawObjJob.Running: boolean;
begin begin
Result:=FRunning; Result := FRunning;
end; end;
constructor TDrawObjJob.Create(aViewer: TMapView; aLst: TGPSObjList; constructor TDrawObjJob.Create(aViewer: TMapView; aLst: TGPSObjList;
const aArea: TRealArea); const aArea: TRealArea);
begin begin
FArea:=aArea; FArea := aArea;
FLst:=aLst; FLst := aLst;
SetLEngth(FStates,FLst.Count); SetLEngth(FStates,FLst.Count);
Viewer:=aViewer; Viewer := aViewer;
AllRun:=false; AllRun := false;
Name:='DrawObj'; Name := 'DrawObj';
end; end;
destructor TDrawObjJob.Destroy; destructor TDrawObjJob.Destroy;
@ -313,119 +316,117 @@ end;
procedure TMapView.SetActive(AValue: boolean); procedure TMapView.SetActive(AValue: boolean);
begin begin
if FActive=AValue then Exit; if FActive = AValue then Exit;
FActive:=AValue; FActive := AValue;
if FActive then if FActive then
ActivateEngine ActivateEngine
else else
Engine.Active:=false; Engine.Active := false;
end; end;
function TMapView.GetCacheOnDisk: boolean; function TMapView.GetCacheOnDisk: boolean;
begin begin
Result:=Engine.CacheOnDisk; Result := Engine.CacheOnDisk;
end; end;
function TMapView.GetCachePath: String; function TMapView.GetCachePath: String;
begin begin
Result:=Engine.CachePath; Result := Engine.CachePath;
end; end;
function TMapView.GetCenter: TRealPoint; function TMapView.GetCenter: TRealPoint;
begin begin
Result:=Engine.Center; Result := Engine.Center;
end; end;
function TMapView.GetMapProvider: String; function TMapView.GetMapProvider: String;
begin begin
result:=Engine.MapProvider; result := Engine.MapProvider;
end; end;
function TMapView.GetOnCenterMove: TNotifyEvent; function TMapView.GetOnCenterMove: TNotifyEvent;
begin begin
result:=Engine.OnCenterMove; result := Engine.OnCenterMove;
end; end;
function TMapView.GetOnChange: TNotifyEvent; function TMapView.GetOnChange: TNotifyEvent;
begin begin
Result:=Engine.OnChange; Result := Engine.OnChange;
end; end;
function TMapView.GetOnZoomChange: TNotifyEvent; function TMapView.GetOnZoomChange: TNotifyEvent;
begin begin
Result:=Engine.OnZoomChange; Result := Engine.OnZoomChange;
end; end;
function TMapView.GetUseThreads: boolean; function TMapView.GetUseThreads: boolean;
begin begin
Result:=Engine.UseThreads; Result := Engine.UseThreads;
end; end;
function TMapView.GetZoom: integer; function TMapView.GetZoom: integer;
begin begin
result:=Engine.Zoom; result := Engine.Zoom;
end; end;
procedure TMapView.SetCacheOnDisk(AValue: boolean); procedure TMapView.SetCacheOnDisk(AValue: boolean);
begin begin
Engine.CacheOnDisk:=AValue; Engine.CacheOnDisk := AValue;
end; end;
procedure TMapView.SetCachePath(AValue: String); procedure TMapView.SetCachePath(AValue: String);
begin begin
Engine.CachePath:=CachePath; Engine.CachePath := CachePath;
end; end;
procedure TMapView.SetCenter(AValue: TRealPoint); procedure TMapView.SetCenter(AValue: TRealPoint);
begin begin
Engine.Center:=AValue; Engine.Center := AValue;
end; end;
procedure TMapView.SetInactiveColor(AValue: TColor); procedure TMapView.SetInactiveColor(AValue: TColor);
begin begin
if FInactiveColor=AValue then Exit; if FInactiveColor = AValue then
FInactiveColor:=AValue; exit;
if not(IsActive) then FInactiveColor := AValue;
invalidate; if not IsActive then
Invalidate;
end; end;
procedure TMapView.ActivateEngine; procedure TMapView.ActivateEngine;
begin begin
Engine.SetSize(ClientWidth,ClientHeight); Engine.SetSize(ClientWidth,ClientHeight);
if IsActive then Engine.Active := IsActive;
Engine.Active:=true
else
Engine.Active:=false;
end; end;
procedure TMapView.SetMapProvider(AValue: String); procedure TMapView.SetMapProvider(AValue: String);
begin begin
Engine.MapProvider:=AValue; Engine.MapProvider := AValue;
end; end;
procedure TMapView.SetOnCenterMove(AValue: TNotifyEvent); procedure TMapView.SetOnCenterMove(AValue: TNotifyEvent);
begin begin
Engine.OnCenterMove:=AValue; Engine.OnCenterMove := AValue;
end; end;
procedure TMapView.SetOnChange(AValue: TNotifyEvent); procedure TMapView.SetOnChange(AValue: TNotifyEvent);
begin begin
Engine.OnChange:=AValue; Engine.OnChange := AValue;
end; end;
procedure TMapView.SetOnZoomChange(AValue: TNotifyEvent); procedure TMapView.SetOnZoomChange(AValue: TNotifyEvent);
begin begin
Engine.OnZoomChange:=AValue; Engine.OnZoomChange := AValue;
end; end;
procedure TMapView.SetUseThreads(AValue: boolean); procedure TMapView.SetUseThreads(AValue: boolean);
begin begin
Engine.UseThreads:=aValue; Engine.UseThreads := aValue;
end; end;
procedure TMapView.SetZoom(AValue: integer); procedure TMapView.SetZoom(AValue: integer);
begin begin
Engine.Zoom:=AValue; Engine.Zoom := AValue;
end; end;
function TMapView.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; function TMapView.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
@ -445,15 +446,16 @@ begin
end; end;
procedure TMapView.MouseUp(Button: TMouseButton; Shift: TShiftState; procedure TMapView.MouseUp(Button: TMouseButton; Shift: TShiftState;
X: Integer; Y: Integer); X, Y: Integer);
begin begin
inherited MouseUp(Button, Shift, X, Y); inherited MouseUp(Button, Shift, X, Y);
if IsActive then if IsActive then
Engine.MouseUp(self,Button,Shift,X,Y); Engine.MouseUp(self,Button,Shift,X,Y);
end; end;
procedure TMapView.MouseMove(Shift: TShiftState; X: Integer; Y: Integer); procedure TMapView.MouseMove(Shift: TShiftState; X, Y: Integer);
var aPt : TPoint; var
aPt: TPoint;
begin begin
inherited MouseMove(Shift, X, Y); inherited MouseMove(Shift, X, Y);
if IsActive then if IsActive then
@ -515,14 +517,15 @@ end;
procedure TMapView.OnGPSItemsModified(Sender: TObject; objs: TGPSObjList; procedure TMapView.OnGPSItemsModified(Sender: TObject; objs: TGPSObjList;
Adding: boolean); Adding: boolean);
var Area,ObjArea,vArea : TRealArea; var
Area,ObjArea,vArea: TRealArea;
begin begin
if Adding and assigned(Objs) then if Adding and assigned(Objs) then
Begin begin
ObjArea:=GetAreaOf(Objs); ObjArea := GetAreaOf(Objs);
vArea:=GetVisibleArea; vArea := GetVisibleArea;
if hasIntersectArea(ObjArea,vArea) then if hasIntersectArea(ObjArea,vArea) then
Begin begin
Area:=IntersectArea(ObjArea,vArea); Area:=IntersectArea(ObjArea,vArea);
Engine.Jobqueue.AddJob(TDrawObjJob.Create(self,Objs,Area),Engine); Engine.Jobqueue.AddJob(TDrawObjJob.Create(self,Objs,Area),Engine);
end end
@ -530,7 +533,7 @@ begin
objs.Free; objs.Free;
end end
else else
Begin begin
Engine.Redraw; Engine.Redraw;
Objs.free; Objs.free;
end; end;
@ -564,16 +567,16 @@ Begin
if not(LastInside) then if not(LastInside) then
Old:=Engine.LonLatToScreen(trk.Points[pred(i)].RealPoint); Old:=Engine.LonLatToScreen(trk.Points[pred(i)].RealPoint);
{$IFDEF USE_RGBGRAPHICS} {$IFDEF USE_RGBGRAPHICS}
Buffer.canvas.OutlineColor := trkColor; Buffer.Canvas.OutlineColor := trkColor;
Buffer.canvas.Line(Old.X,Old.y,New.X,New.Y); Buffer.Canvas.Line(Old.X, Old.y, New.X, New.Y);
{$ENDIF} {$ENDIF}
{$IFDEF USE_LAZINTFIMAGE} {$IFDEF USE_LAZINTFIMAGE}
BufferCanvas.Pen.FPColor := TColorToFPColor(trkColor); BufferCanvas.Pen.FPColor := TColorToFPColor(trkColor);
BufferCanvas.Line(Old.X, Old.Y, New.X, New.Y); BufferCanvas.Line(Old.X, Old.Y, New.X, New.Y);
{$ENDIF} {$ENDIF}
end; end;
Old:=New; Old := New;
LastInside:=IsInside; LastInside := IsInside;
end; end;
end; end;
end; end;
@ -727,7 +730,7 @@ begin
FGPSItems.OnModified := @OnGPSItemsModified; FGPSItems.OnModified := @OnGPSItemsModified;
FInactiveColor := clWhite; FInactiveColor := clWhite;
FEngine := TMapViewerEngine.Create(self); FEngine := TMapViewerEngine.Create(self);
dl := TMVDESynapse.Create(self); FdownloadEngine := TMvDEFpc.Create(self);
{$IFDEF USE_RGBGRAPHICS} {$IFDEF USE_RGBGRAPHICS}
Buffer := TRGB32Bitmap.Create(Width,Height); Buffer := TRGB32Bitmap.Create(Width,Height);
{$ENDIF} {$ENDIF}
@ -738,7 +741,7 @@ begin
Engine.CacheOnDisk := true; Engine.CacheOnDisk := true;
Engine.OnDrawTile := @DoDrawTile; Engine.OnDrawTile := @DoDrawTile;
Engine.DrawTitleInGuiThread := false; Engine.DrawTitleInGuiThread := false;
Engine.DownloadEngine := dl; Engine.DownloadEngine := FDownloadengine;
inherited Create(AOwner); inherited Create(AOwner);
Width := 150; Width := 150;
Height := 150; Height := 150;