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

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
Classes, SysUtils;
Type
{ TCustomDownloadEngine }
type
TCustomDownloadEngine = class(TComponent)
{ TMvCustomDownloadEngine }
TMvCustomDownloadEngine = class(TComponent)
public
procedure DownloadFile(const Url: string; str: TStream); virtual;
procedure DownloadFile(const Url: string; AStream: TStream); virtual;
end;
implementation
{ TCustomDownloadEngine }
{ TMvCustomDownloadEngine }
procedure TCustomDownloadEngine.DownloadFile(const Url: string; str: TStream);
procedure TMvCustomDownloadEngine.DownloadFile(const Url: string; AStream: TStream);
begin
end;

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

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

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

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

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

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