diff --git a/components/lazmapviewer/example/MapViewer_Demo.lpi b/components/lazmapviewer/example/MapViewer_Demo.lpi new file mode 100644 index 000000000..323dc923f --- /dev/null +++ b/components/lazmapviewer/example/MapViewer_Demo.lpi @@ -0,0 +1,82 @@ + + + + + + + + + + <Scaled Value="True"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + <Icon Value="0"/> + </General> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + <Modes Count="0"/> + </RunParams> + <RequiredPackages Count="2"> + <Item1> + <PackageName Value="lazMapViewerPkg"/> + </Item1> + <Item2> + <PackageName Value="LCL"/> + </Item2> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="MapViewer_Demo.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="main.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="Main"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="MapViewer_Demo"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/components/lazmapviewer/example/MapViewer_Demo.lpr b/components/lazmapviewer/example/MapViewer_Demo.lpr new file mode 100644 index 000000000..f4b4e5afc --- /dev/null +++ b/components/lazmapviewer/example/MapViewer_Demo.lpr @@ -0,0 +1,22 @@ +program MapViewer_Demo; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, Main + { you can add units after this }; + +{$R *.res} + +begin + RequireDerivedFormResource:=True; + Application.Scaled:=True; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/components/lazmapviewer/example/main.lfm b/components/lazmapviewer/example/main.lfm new file mode 100644 index 000000000..4ba43498f --- /dev/null +++ b/components/lazmapviewer/example/main.lfm @@ -0,0 +1,8 @@ +object Form1: TForm1 + Left = 258 + Height = 545 + Top = 127 + Width = 869 + Caption = 'Form1' + LCLVersion = '1.9.0.0' +end diff --git a/components/lazmapviewer/example/main.pas b/components/lazmapviewer/example/main.pas new file mode 100644 index 000000000..f3d1b7dd4 --- /dev/null +++ b/components/lazmapviewer/example/main.pas @@ -0,0 +1,29 @@ +unit Main; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls; + +type + + { TForm1 } + + TForm1 = class(TForm) + private + + public + + end; + +var + Form1: TForm1; + +implementation + +{$R *.lfm} + +end. + diff --git a/components/lazmapviewer/lazmapviewerpkg.lpk b/components/lazmapviewer/lazmapviewerpkg.lpk new file mode 100644 index 000000000..2081f1774 --- /dev/null +++ b/components/lazmapviewer/lazmapviewerpkg.lpk @@ -0,0 +1,93 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <Package Version="4"> + <Name Value="lazMapViewerPkg"/> + <Type Value="RunAndDesignTime"/> + <CompilerOptions> + <Version Value="11"/> + <SearchPaths> + <OtherUnitFiles Value="source"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + </CompilerOptions> + <Files Count="13"> + <Item1> + <Filename Value="source/mvcache.pas"/> + <UnitName Value="mvCache"/> + </Item1> + <Item2> + <Filename Value="source/mvdlesynapse.pas"/> + <UnitName Value="mvDLESynapse"/> + </Item2> + <Item3> + <Filename Value="source/mvdownloadengine.pas"/> + <UnitName Value="mvDownloadEngine"/> + </Item3> + <Item4> + <Filename Value="source/mvdragobj.pas"/> + <UnitName Value="mvdragobj"/> + </Item4> + <Item5> + <Filename Value="source/mvengine.pas"/> + <UnitName Value="mvEngine"/> + </Item5> + <Item6> + <Filename Value="source/mvgeonames.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="mvgeonames"/> + </Item6> + <Item7> + <Filename Value="source/mvgpsobj.pas"/> + <UnitName Value="mvgpsobj"/> + </Item7> + <Item8> + <Filename Value="source/mvjobqueue.pas"/> + <UnitName Value="mvJobQueue"/> + </Item8> + <Item9> + <Filename Value="source/mvjobs.pas"/> + <UnitName Value="mvJobs"/> + </Item9> + <Item10> + <Filename Value="source/mvmapprovider.pas"/> + <UnitName Value="mvMapProvider"/> + </Item10> + <Item11> + <Filename Value="source/mvtypes.pas"/> + <UnitName Value="mvtypes"/> + </Item11> + <Item12> + <Filename Value="source/mvmapviewer.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="mvmapviewer"/> + </Item12> + <Item13> + <Filename Value="source/mvextradata.pas"/> + <UnitName Value="mvextradata"/> + </Item13> + </Files> + <RequiredPkgs Count="4"> + <Item1> + <PackageName Value="laz_synapse"/> + </Item1> + <Item2> + <PackageName Value="rgb_graphics"/> + </Item2> + <Item3> + <PackageName Value="LCLBase"/> + </Item3> + <Item4> + <PackageName Value="FCL"/> + </Item4> + </RequiredPkgs> + <UsageOptions> + <UnitPath Value="$(PkgOutDir)"/> + </UsageOptions> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <CustomOptions Items="ExternHelp" Version="2"> + <_ExternHelp Items="Count"/> + </CustomOptions> + </Package> +</CONFIG> diff --git a/components/lazmapviewer/lazmapviewerpkg.pas b/components/lazmapviewer/lazmapviewerpkg.pas new file mode 100644 index 000000000..36ffb3100 --- /dev/null +++ b/components/lazmapviewer/lazmapviewerpkg.pas @@ -0,0 +1,27 @@ +{ This file was automatically created by Lazarus. Do not edit! + This source is only used to compile and install the package. + } + +unit lazMapViewerPkg; + +{$warn 5023 off : no warning about unused units} +interface + +uses + mvCache, mvDLESynapse, mvDownloadEngine, mvDragObj, mvEngine, mvGeoNames, + mvGPSObj, mvJobQueue, mvJobs, mvMapProvider, mvTypes, mvMapViewer, + mvExtraData, + LazarusPackageIntf; + +implementation + +procedure Register; +begin + RegisterUnit('mvgeonames', @mvgeonames.Register); + RegisterUnit('mvmapviewer', @mvmapviewer.Register); +end; + +initialization + RegisterPackage('lazMapViewerPkg', @Register); + +end. diff --git a/components/lazmapviewer/source/mvcache.pas b/components/lazmapviewer/source/mvcache.pas new file mode 100644 index 000000000..916808548 --- /dev/null +++ b/components/lazmapviewer/source/mvcache.pas @@ -0,0 +1,360 @@ +{ + Picture cache manager (c) 2014 ti_dic + + 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. +} +unit mvCache; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils,mvmapprovider,IntfGraphics,syncObjs,mvtypes; + +Type + + { TPictureCache } + + TPictureCache = Class(TComponent) + private + FMemMaxElem : integer; + Crit : TCriticalSection; + Cache : TStringList; + FBasePath: String; + FUseDisk: Boolean; + FUseThreads: Boolean; + procedure SetUseThreads(AValue: Boolean); + Procedure EnterCrit; + Procedure LeaveCrit; + protected + function GetNewImgFor(aStream : TStream) : TLazIntfImage; + procedure FreeCache; + Function MapProvider2FileName(MapProvider : TMapProvider) : String; + Function DiskCached(const aFileName : String) : Boolean; + procedure LoadFromDisk(const aFileName : String;out img : TLazIntfImage); + Function GetFileName(MapProvider : TMapProvider;const TileId : TTileId) : String; + public + Procedure CheckCacheSize(sender : TObject); + constructor Create(aOwner : TComponent);override; + destructor destroy;override; + Procedure Add(MapProvider : TMapProvider;const TileId : TTileId;Stream : TMemoryStream); + Procedure GetFromCache(MapProvider : TMapProvider;const TileId : TTileId;out img : TLazIntfImage); + function InCache(MapProvider : TMapProvider;const TileId : TTileId) : Boolean; + + property UseDisk : Boolean read FUseDisk write FUseDisk; + property BasePath : String read FBasePath write FBasePath; + property UseThreads : Boolean read FUseThreads write SetUseThreads; + end; + + +implementation +uses FPimage,GraphType,FPReadJPEG; + +{ TPictureCache } + +function IsValidPNG(stream: TStream): Boolean; +var + s: string; + y: Int64; +begin + if Assigned(stream) then + begin + SetLength(s, 3); + y := stream.Position; + stream.Position := 1; + stream.Read(s[1], 3); + stream.Position := y; + Result := s = 'PNG'; + end + else + Result := False; +end; + +function IsValidJPEG(stream: TStream): Boolean; +var + s: string; + y: Int64; +begin + if Assigned(stream) then + begin + SetLength(s, 4); + y := stream.Position; + stream.Position := 6; + stream.Read(s[1], 4); + stream.Position := y; + Result := (s = 'JFIF') or (s = 'Exif'); + end + else + Result := False; +end; + +procedure TPictureCache.SetUseThreads(AValue: Boolean); +begin + if FUseThreads=AValue then Exit; + FUseThreads:=AValue; + if aValue then + Crit:=TCriticalSection.Create + else + FreeAndnil(Crit); +end; + +procedure TPictureCache.EnterCrit; +begin + if Assigned(Crit) then + Crit.Enter; +end; + +procedure TPictureCache.LeaveCrit; +begin + if Assigned(Crit) then + Crit.Leave; +end; + +function TPictureCache.GetNewImgFor(aStream: TStream): TLazIntfImage; +var + reader : TFPCustomImageReader; + rawImg : TRawImage; +begin + result:=nil; + Reader := nil; + if not(assigned(aStream)) then + exit; + if IsValidJPEG(astream) then + Reader := TFPReaderJPEG.create + else + if IsValidPNG(astream) then + Reader := TLazReaderPNG.create; + if Assigned(reader) then + Begin + try + rawImg.Init; + rawImg.Description.Init_BPP24_B8G8R8_BIO_TTB(TILE_SIZE,TILE_SIZE); + Result:=TLazIntfImage.create(rawImg,true); + Try + Result.LoadFromStream(aStream,reader); + except + FreeAndNil(result); + end; + finally + FreeAndNil(Reader) + end; + end; +end; + +procedure TPictureCache.FreeCache; +var i : integer; +begin + EnterCrit; + Try + For i:=0 to pred(Cache.Count) do + begin + Cache.Objects[i].Free; + end; + Cache.Clear; + Cache.Free; + finally + LeaveCrit; + end; +end; + +function TPictureCache.MapProvider2FileName(MapProvider: TMapProvider): String; +var i : integer; +begin + Result:=''; + if Assigned(MapProvider) then + begin + Result:=MapProvider.Name; + For i:=1 to length(Result) do + if not(result[i] in ['a'..'z','A'..'Z','0'..'9','_','.']) then + Result[i]:='-'; + end; +end; + +function TPictureCache.DiskCached(const aFileNAme: String): Boolean; +Var FullFileName : string; +begin + if UseDisk then + Begin + FullFileName:=BasePath+aFileName; + Result:=FileExists(FullFileName); + end + Else + Result:=False; +end; + +procedure TPictureCache.LoadFromDisk(const aFileName: String; out + img: TLazIntfImage); +var FullFileName : String; + aStream : TFileStream; +begin + img:=nil; + FullFileName:=BasePath+aFileName; + if FileExists(fullFileName) then + Begin + aStream:=TFileStream.Create(FullFileName,fmOpenRead); + try + Try + img:=GetNewImgFor(aStream); + except + FreeAndNil(img); + end; + if Assigned(img) then + begin + EnterCrit; + Try + Cache.AddObject(aFileName,img); + finally + LeaveCrit; + end; + end; + finally + aStream.Free; + end; + end; +end; + +function TPictureCache.GetFileName(MapProvider: TMapProvider;const TileId: TTileId + ): String; +begin + Result:=MapProvider2FileName(MapProvider)+'_'+inttostr(TileId.X)+'_'+inttostr(TileId.Y)+'_'+inttostr(TileId.Z); +end; + +procedure TPictureCache.CheckCacheSize(Sender : TObject); +var i ,idx : integer; +begin + EnterCrit; + try + if Cache.Count>FMemMaxElem then + Begin + For i:=1 to 10 do + Begin + idx:=pred(Cache.Count); + if idx>1 then + Begin + Cache.Objects[idx].free; + Cache.Delete(idx); + end; + end; + end; + finally + LeaveCrit; + end; +end; + +constructor TPictureCache.Create(aOwner: TComponent); +begin + inherited Create(aOwner); + FMemMaxElem :=2048 div 256; + Cache:=TStringList.create; +end; + +destructor TPictureCache.destroy; +begin + inherited destroy; + FreeCache; + FreeAndNil(Crit); +end; + +procedure TPictureCache.Add(MapProvider: TMapProvider;const TileId: TTileId; + Stream: TMemoryStream); +var FileName : String; + img : TLazIntfImage; + aFile : TFileStream; + idx : integer; +begin + FileName:=GetFileName(MapProvider,TileId); + EnterCrit; + Try + idx:=Cache.IndexOF(FileName); + if idx<>-1 then + Cache.Objects[idx].Free + else + Begin + Cache.Insert(0,FileName); + idx:=0; + end; + img:=GetNewImgFor(Stream); + Cache.Objects[idx]:=img; + finally + LeaveCrit; + end; + if UseDisk then + Begin + if assigned(img) then + Begin + aFile:=TFileStream.Create(BasePath+FileName,fmCreate); + Try + Stream.Position:=0; + aFile.CopyFrom(Stream,0); + finally + FreeAndNil(aFile); + end; + end; + end; + if Not(FUseThreads) then + CheckCacheSize(self); +end; + +procedure TPictureCache.GetFromCache(MapProvider: TMapProvider;const TileId: TTileId; out img: TLazIntfImage); +var FileName : String; + idx : integer; +begin + img:=nil; + FileName:=GetFileName(MapProvider,TileId); + EnterCrit; + Try + idx:=Cache.IndexOF(FileName); + if idx<>-1 then + Begin + img:=TLazIntfImage(Cache.Objects[idx]); + if Idx>FMemMaxElem div 2 then + Begin + Cache.Delete(idx); + Cache.Insert(0,FileName); + Cache.Objects[0]:=img; + end; + end; + + finally + leaveCrit; + end; + if idx=-1 then + Begin + if UseDisk then + LoadFromDisk(FileName,img); + end; +end; + +function TPictureCache.InCache(MapProvider: TMapProvider;const TileId: TTileId + ): Boolean; +var FileName : String; + idx : integer; +begin + FileName:=GetFileName(MapProvider,TileId); + EnterCrit; + try + idx:=Cache.IndexOF(FileNAme); + finally + leaveCrit; + end; + if idx<>-1 then + Result:=True + else + Result:=DiskCached(FileName); +end; + +end. + diff --git a/components/lazmapviewer/source/mvdlesynapse.pas b/components/lazmapviewer/source/mvdlesynapse.pas new file mode 100644 index 000000000..ab6fd9d9e --- /dev/null +++ b/components/lazmapviewer/source/mvdlesynapse.pas @@ -0,0 +1,80 @@ +{ Map Viewer Download Engine Synapse + + 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. +} +unit mvDLESynapse; + +{$mode objfpc}{$H+} + +interface + +uses + mvDownloadEngine,SysUtils, Classes, httpsend; + +type + + { TMVDESynapse } + + TMVDESynapse = class(TCustomDownloadEngine) + private + FProxyHost: string; + FProxyPassword: string; + FProxyPort: Integer; + FProxyUsername: string; + FUseProxy: Boolean; + public + procedure DownloadFile(const Url: string; str: TStream); override; + + published + property UseProxy: Boolean read FUseProxy write FUseProxy; + property ProxyHost: string read FProxyHost write FProxyHost; + property ProxyPort: Integer read FProxyPort write FProxyPort; + property ProxyUsername: string read FProxyUsername write FProxyUsername; + property ProxyPassword: string read FProxyPassword write FProxyPassword; + end; + +implementation + +{ TMVDESynapse } + +procedure TMVDESynapse.DownloadFile(const Url: string; str: TStream); +var + FHttp: THTTPSend; +begin + inherited DownloadFile(Url, str); + FHttp := THTTPSend.Create; + try + if FUseProxy then + begin + FHTTP.ProxyHost := FProxyHost; + FHTTP.ProxyPort := IntToStr(FProxyPort); + FHTTP.ProxyUser := FProxyUsername; + FHTTP.ProxyPass := FProxyPassword; + end; + + if FHTTP.HTTPMethod('GET', Url) then + begin + str.Seek(0, soFromBeginning); + str.CopyFrom(FHTTP.Document, 0); + str.Position := 0; + end; + finally + FHttp.Free; + end; +end; + +end. diff --git a/components/lazmapviewer/source/mvdownloadengine.pas b/components/lazmapviewer/source/mvdownloadengine.pas new file mode 100644 index 000000000..5850a8eb4 --- /dev/null +++ b/components/lazmapviewer/source/mvdownloadengine.pas @@ -0,0 +1,46 @@ +{ Map Viewer Download Engine Synapse + + 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. +} +unit mvDownloadEngine; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; +Type + + { TCustomDownloadEngine } + + TCustomDownloadEngine = class(TComponent) + public + procedure DownloadFile(const Url: string; str: TStream); virtual; + end; + +implementation + +{ TCustomDownloadEngine } + +procedure TCustomDownloadEngine.DownloadFile(const Url: string; str: TStream); +begin + +end; + +end. + diff --git a/components/lazmapviewer/source/mvdragobj.pas b/components/lazmapviewer/source/mvdragobj.pas new file mode 100644 index 000000000..72e295664 --- /dev/null +++ b/components/lazmapviewer/source/mvdragobj.pas @@ -0,0 +1,202 @@ +{ + (c) 2014 ti_dic + + 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. +} +unit mvdragobj; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +Type + TDragObj = Class; + + TDragEvent = Procedure (Sender : TDragObj) of Object; + + { TDragObj } + + TDragObj = Class + private + FMouseDown : boolean; + FLnkObj: TObject; + FDragsrc,FStartSrc : TObject; + FOfsX: integer; + FOfsY: integer; + InDrag : Boolean; + FStartX,FStartY : integer; + FMouseX,FMouseY : integer; + FEndX,FEndY : integer; + FOnDrag: TDragEvent; + FOnEndDrag: TDragEvent; + + procedure SetDest(X,Y : Integer); + procedure SetLnkObj(AValue: TObject); + procedure SetOnDrag(AValue: TDragEvent); + procedure SetOnEndDrag(AValue: TDragEvent); + + Procedure DostartDrag(X,Y : Integer); + Procedure DoDrag(X,Y : integer); + Procedure DoEndDrag(X,Y : integer); + Function HasMoved(X,Y : integer) : Boolean; + Procedure AbortDrag; + + public + Procedure MouseDown(aDragSrc : TObject;X,Y : integer); + Procedure MouseUp(X,Y : integer); + Procedure MouseMove(X,Y : integer); + + property OnDrag : TDragEvent read FOnDrag write SetOnDrag; + property OnEndDrag : TDragEvent read FOnEndDrag write SetOnEndDrag; + + + + property OfsX : integer read FOfsX; + property OfsY : integer read FOfsY; + property StartX : integer read FStartX; + property StartY : integer read FStartY; + property MouseX : Integer read FMouseX; + property MouseY : integer read FMouseY; + property EndX : integer read FEndX; + property EndY : integer read FEndY; + Property LnkObj : TObject Read FLnkObj write SetLnkObj; + property DragSrc : TObject Read FStartSrc; + end; + +implementation + +{ TDragObj } + +procedure TDragObj.SetDest(X, Y: Integer); +begin + FEndX:=X; + FEndY:=Y; + FOfsX:=FEndX-FstartX; + FOfsY:=FEndY-FstartY; +end; + +procedure TDragObj.SetLnkObj(AValue: TObject); +begin + if FLnkObj=AValue then Exit; + FreeAndNil(FLnkObj); + FLnkObj:=AValue; +end; + +procedure TDragObj.SetOnDrag(AValue: TDragEvent); +begin + if FOnDrag=AValue then Exit; + FOnDrag:=AValue; +end; + +procedure TDragObj.SetOnEndDrag(AValue: TDragEvent); +begin + if FOnEndDrag=AValue then Exit; + FOnEndDrag:=AValue; +end; + +procedure TDragObj.DostartDrag(X, Y: Integer); +begin + InDrag:=True; + FStartSrc := FDragSrc; + DoDrag(X,Y); +end; + +procedure TDragObj.DoDrag(X, Y: integer); +begin + if (X<>FEndX) or (Y<>FEndY) then + Begin + SetDest(X,Y); + if Assigned(FOnDrag) then + FOnDrag(Self); + end; +end; + +procedure TDragObj.DoEndDrag(X, Y: integer); +begin + DoDrag(X,Y); + if Assigned(FOnEndDrag) then + FOnEndDrag(self); + FreeAndNil(FLnkObj); + FStartSrc := nil; + InDrag:=False; +end; + +function TDragObj.HasMoved(X, Y: integer): Boolean; +begin + Result:=(X<>FStartX) or (Y<>FStartY); +end; + +procedure TDragObj.AbortDrag; +begin + if InDrag then + Begin + DoDrag(FstartX,FStartY); + InDrag:=False; + FMouseDown:=False; + FDragSrc :=nil; + FStartSrc := nil; + FreeAndNil(FLnkObj); + end; +end; + +procedure TDragObj.MouseDown(aDragSrc : TObject;X, Y: integer); +begin + if not(FMouseDown) then + Begin + FDragSrc := aDragSrc; + FMouseDown := True; + FStartX := X; + FStartY := Y; + FEndX := X; + FEndY := Y; + End + Else + AbortDrag; +end; + + +procedure TDragObj.MouseMove(X, Y: integer); +begin + FMouseX := X; + FMouseY := Y; + if FMouseDown then + Begin + if InDrag then + DoDrag(X,Y) + else + Begin + if HasMoved(X,Y) then + DoStartDrag(X,Y); + end; + end; +end; + + +procedure TDragObj.MouseUp(X, Y: integer); +begin + if FMouseDown then + Begin + FMouseDown:=False; + if InDrag then + DoEndDrag(X,Y); + FDragSrc := nil; + end; +end; + +end. + diff --git a/components/lazmapviewer/source/mvengine.pas b/components/lazmapviewer/source/mvengine.pas new file mode 100644 index 000000000..a6f4b8baf --- /dev/null +++ b/components/lazmapviewer/source/mvengine.pas @@ -0,0 +1,930 @@ +{ + (c) 2014 ti_dic + Parts of this component are based on : + Map Viewer 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. +} + + +unit mvEngine; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils,mvJobQueue,mvmapprovider,mvDownloadEngine,IntfGraphics, + mvCache,mvdragobj,controls,mvtypes; + +const + EARTH_RADIUS = 6378137; + MIN_LATITUDE = -85.05112878; + MAX_LATITUDE = 85.05112878; + MIN_LONGITUDE = -180; + MAX_LONGITUDE = 180; + SHIFT = 2 * pi * EARTH_RADIUS / 2.0; + + +Type + TDrawTileEvent = Procedure (const TileId : TTileId;X,Y : integer;TileImg : TLazIntfImage) of object; + + TTileIdArray = Array of TTileId; + + { TMapWindow } + TMapWindow = Record + MapProvider: TMapProvider; + X: Int64; + Y: Int64; + Center : TRealPoint; + Zoom: integer; + Height: integer; + Width: integer; + end; + + + { TMapViewerEngine } + + TMapViewerEngine = Class(TComponent) + private + DragObj : TDragObj; + Cache : TPictureCache; + FActive: boolean; + FDownloadEngine: TCustomDownloadEngine; + FDrawTitleInGuiThread: boolean; + FOnCenterMove: TNotifyEvent; + FOnChange: TNotifyEvent; + FOnDrawTile: TDrawTileEvent; + FOnZoomChange: TNotifyEvent; + lstProvider : TStringList; + Queue : TJobQueue; + MapWin : TMapWindow; + procedure ConstraintZoom(var aWin: TMapWindow); + function GetCacheOnDisk: Boolean; + function GetCachePath: String; + function GetCenter: TRealPoint; + function GetHeight: integer; + function GetMapProvider: String; + function GetUseThreads: Boolean; + function GetWidth: integer; + function GetZoom: integer; + function IsValidTile(const aWin: TMapWindow; const aTile: TTIleId + ): boolean; + procedure MoveMapCenter(Sender: TDragObj); + procedure SetActive(AValue: boolean); + procedure SetCacheOnDisk(AValue: Boolean); + procedure SetCachePath(AValue: String); + procedure SetDownloadEngine(AValue: TCustomDownloadEngine); + procedure SetHeight(AValue: integer); + procedure SetMapProvider(AValue: String); + procedure SetUseThreads(AValue: Boolean); + procedure SetWidth(AValue: integer); + procedure SetZoom(AValue: integer); + function LonLatToMapWin(const aWin: TMapWindow; aPt: TRealPoint): TPoint; + Function MapWinToLonLat(const aWin: TMapWindow; aPt : TPoint) : TRealPoint; + Procedure CalculateWin(var aWin : TMapWindow); + Procedure Redraw(const aWin : TmapWindow); + function CalculateVisibleTiles(const aWin : TMapWindow) : TArea; + function IsCurrentWin(const aWin : TMapWindow) : boolean; + protected + function GetTileName(const Id : TTileId) : String; + procedure evDownload(Data : TObject;Job : TJob); + procedure TileDownloaded(Data: PtrInt); + Procedure RegisterProviders; + Procedure DrawTile(const TileId : TTileId;X,Y : integer;TileImg : TLazIntfImage); + + function GetLetterSvr(id: integer): String; + function GetYahooSvr(id: integer): String; + function GetYahooY(const Tile : TTileId): string; + function GetYahooZ(const Tile : TTileId): string; + function GetQuadKey(const Tile : TTileId): string; + + 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; + 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 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); + + + 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; + property CacheOnDisk : Boolean read GetCacheOnDisk write SetCacheOnDisk; + property CachePath : String read GetCachePath write SetCachePath; + property Active : boolean read FActive write SetActive; + + 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; + +implementation +uses Math,mvJobs,forms,mvgpsobj; + +Type + + { TLaunchDownloadJob } + + TLaunchDownloadJob = Class(TJob) + private + AllRun : boolean; + Win : TMapWindow; + Engine : TMapViewerEngine; + FRunning : boolean; + FTiles : TTileIdArray; + FStates : Array of integer; + protected + function pGetTask : integer;override; + procedure pTaskStarted(aTask: integer);override; + procedure pTaskEnded(aTask : integer;aExcept : Exception);override; + public + procedure ExecuteTask(aTask : integer;FromWaiting : boolean);override; + function Running : boolean;override; + public + Constructor Create(Eng : TMapViewerEngine;const Tiles : TTileIdArray;const aWin : TMapWindow); + end; + + +{ TEnvTile } + + TEnvTile = Class + private + Tile : TTileId; + Win : TMapWindow; + public + constructor Create(const aTile : TTileId;Const aWin : TMapWindow); + End; + +{ TLaunchDownloadJob } + +function TLaunchDownloadJob.pGetTask: integer; +var i : integer; +begin + if not(AllRun) and not(Cancelled) then + Begin + For i:=low(FStates) to high(FStates) do + if FStates[i]=0 then + Begin + result:=i+1; + Exit; + end; + AllRun:=True; + end; + Result:=ALL_TASK_COMPLETED; + For i:=low(FStates) to high(FStates) do + if FStates[i]=1 then + Begin + Result:=NO_MORE_TASK; + Exit; + end; +end; + +procedure TLaunchDownloadJob.pTaskStarted(aTask: integer); +begin + FRunning:=True; + FStates[aTask-1]:=1; +end; + +procedure TLaunchDownloadJob.pTaskEnded(aTask: integer; aExcept: Exception); +begin + if Assigned(aExcept) then + FStates[aTask-1]:=3 + Else + FStates[aTask-1]:=2; +end; + +procedure TLaunchDownloadJob.ExecuteTask(aTask: integer; FromWaiting: boolean); +var iTile : integer; +begin + iTile:=aTask-1; + Queue.AddUniqueJob(TEventJob.Create(@Engine.evDownload,TEnvTile.Create(FTiles[iTile],Win),false,Engine.GetTileName(FTiles[iTile])),Launcher); +end; + +function TLaunchDownloadJob.Running: boolean; +begin + Result:=FRunning; +end; + +constructor TLaunchDownloadJob.Create(Eng : TMapViewerEngine;const Tiles: TTileIdArray;const aWin : TMapWindow); +var i : integer; +begin + Engine:=Eng; + SetLength(FTiles,Length(Tiles)); + For i:=low(FTiles) to high(FTiles) do + FTiles[i]:=Tiles[i]; + SetLength(FStates,length(Tiles)); + AllRun:=false; + Name:='LaunchDownload'; + Win:=aWin; +end; + +{ TEnvTile } + +constructor TEnvTile.Create(const aTile : TTileId;Const aWin : TMapWindow); +begin + Tile:=aTile; + Win:=aWin; +end; + + +{ TMapViewerEngine } + +procedure TMapViewerEngine.SetZoom(AValue: integer); +begin + if MapWin.Zoom=AValue then Exit; + MapWin.Zoom:=AValue; + ConstraintZoom(MapWin); + CalculateWin(MapWin); + Redraw(MapWin); + if assigned(OnZoomChange) then + OnZoomChange(Self); + if Assigned(OnChange) then + OnChange(Self); +end; + +procedure TMapViewerEngine.SetWidth(AValue: integer); +begin + if MapWin.Width=AValue then Exit; + MapWin.Width:=AValue; + CalculateWin(MapWin); + Redraw(MapWin); +end; + +procedure TMapViewerEngine.SetHeight(AValue: integer); +begin + if MapWin.Height=AValue then Exit; + MapWin.Height:=AValue; + CalculateWin(MapWin); + Redraw(MapWin); +end; + +procedure TMapViewerEngine.ConstraintZoom(var aWin : TMapWindow); +var zMin,zMax :integer; +Begin + if Assigned(aWin.MapProvider) then + Begin + aWin.MapProvider.GetZoomInfos(zMin,zMax); + if aWin.Zoom<zMin then + aWin.Zoom:=zMin; + if aWin.Zoom>zMax then + aWin.Zoom:=zMax; + End; +end; + +procedure TMapViewerEngine.SetMapProvider(AValue: String); +var idx : integer; + zMin,zMax : integer; +begin + idx:=lstProvider.IndexOf(aValue); + if not((aValue='') or (idx<>-1)) then + Raise Exception.Create('Unknow Provider : '+aValue); + if Assigned(MapWin.MapProvider) and (MapWin.MapProvider.Name=AValue) then Exit; + if idx<>-1 then + Begin + MapWin.MapProvider:=TMapProvider(lstProvider.Objects[idx]); + ConstraintZoom(MapWin); + end + else + MapWin.MapProvider:=nil; + if Assigned(MapWin.MapProvider) then + Redraw(MapWin); +end; + + +procedure TMapViewerEngine.SetUseThreads(AValue: Boolean); +begin + if Queue.UseThreads=AValue then Exit; + Queue.UseThreads:=AValue; + Cache.UseThreads:=AValue; +end; + +function TMapViewerEngine.GetZoom: integer; +begin + Result:=MapWin.zoom; +end; + +procedure TMapViewerEngine.SetCacheOnDisk(AValue: Boolean); +begin + if Cache.UseDisk=AValue then Exit; + Cache.UseDisk:=AValue; +end; + +procedure TMapViewerEngine.SetCachePath(AValue: String); +begin + Cache.BasePath:=aValue; +end; + +procedure TMapViewerEngine.SetDownloadEngine(AValue: TCustomDownloadEngine); +begin + if FDownloadEngine=AValue then Exit; + FDownloadEngine:=AValue; + if Assigned(FDownloadEngine) then + FDownloadEngine.FreeNotification(self); +end; + + +function TMapViewerEngine.GetHeight: integer; +begin + Result:=MapWin.Height +end; + +function TMapViewerEngine.GetCacheOnDisk: Boolean; +begin + Result:=Cache.UseDisk; +end; + +function TMapViewerEngine.GetCachePath: String; +begin + Result:=Cache.BasePath; +end; + +function TMapViewerEngine.GetCenter: TRealPoint; +begin + Result:=MapWin.Center; +end; + +function TMapViewerEngine.GetMapProvider: String; +begin + if Assigned(MapWin.MapProvider) then + Result:=MapWin.MapProvider.Name + else + Result:=''; +end; + +function TMapViewerEngine.GetUseThreads: Boolean; +begin + Result:=Queue.UseThreads; +end; + +function TMapViewerEngine.GetWidth: integer; +begin + Result:=MapWin.Width +end; + +function TMapViewerEngine.ScreenToLonLat(aPt: TPoint): TRealPoint; +begin + Result:=MapWinToLonLat(MapWin,aPt); +end; + +function TMapViewerEngine.LonLatToScreen(aPt: TRealPoint): TPoint; +Begin + Result:=LonLatToMapWin(MapWin,aPt); +end; + +function TMapViewerEngine.WorldScreenToLonLat(aPt: TPoint): TRealPoint; +begin + aPt.X:=aPt.X-MapWin.X; + aPt.Y:=aPt.Y-MapWin.Y; + Result:=ScreenToLonLat(aPt); +end; + +function TMapViewerEngine.LonLatToWorldScreen(aPt: TRealPoint): TPoint; +begin + Result:=LonLatToScreen(aPt); + Result.X:=Result.X+MapWin.X; + Result.Y:=Result.Y+MapWin.Y; +end; + +procedure TMapViewerEngine.SetSize(aWidth, aHeight: integer); +begin + if (MapWin.Width=aWidth) and (MapWin.Height=aHeight) then Exit; + CancelCurrentDrawing; + MapWin.Width:=aWidth; + MapWin.Height:=aHeight; + CalculateWin(MapWin); + Redraw(MapWin); + if Assigned(Onchange) then + OnChange(Self); +end; + +procedure TMapViewerEngine.MouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + if Button=mbLeft then + DragObj.MouseDown(self,X,Y); +end; + +procedure TMapViewerEngine.MouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + if Button=mbLeft then + DragObj.MouseUp(X,Y); +end; + +procedure TMapViewerEngine.MouseMove(Sender: TObject; Shift: TShiftState; X, + Y: Integer); +begin + DragObj.MouseMove(X,Y); +end; + +procedure TMapViewerEngine.DblClick(Sender: TObject); +var pt: TPoint; +begin + pt.X:=DragObj.MouseX; + pt.Y:=DragObj.MouseY; + SetCenter(ScreenToLonLat(pt)); +end; + +procedure TMapViewerEngine.MouseWheel(Sender: TObject; + Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; + var Handled: Boolean); +var Val : Integer; + nZoom : integer; +begin + Val:=0; + if WheelDelta>0 then + Val:=1; + if WheelDelta<0 then + Val:=-1; + nZoom:=Zoom+Val; + if (nZoom>0) and (nZoom<20) then + Zoom:=nZoom; + Handled:=true; +end; + +procedure TMapViewerEngine.SetCenter(aCenter: TRealPoint); +begin + if (MapWin.Center.lon<>aCenter.Lon) and (MapWin.Center.lat<>aCenter.Lat) then + Begin + Mapwin.center:=aCenter; + CalculateWin(MapWin); + Redraw(MapWin); + if assigned(OnCenterMove) then + OnCenterMove(Self); + if Assigned(OnChange) then + OnChange(Self); + end; +end; + +procedure TMapViewerEngine.ZoomOnArea(const aArea: TRealArea); +var tmpWin : TMapWindow; + visArea : TRealArea; + TopLeft,BottomRight : TPoint; +begin + tmpWin:=MapWin; + tmpWin.Center.Lon:=(aArea.TopLeft.Lon+aArea.BottomRight.Lon)/2; + tmpWin.Center.Lat:=(aArea.TopLeft.Lat+aArea.BottomRight.Lat)/2; + tmpWin.Zoom:=15; + TopLeft.X:=0; + TopLeft.Y:=0; + BottomRight.X:=tmpWin.Width; + BottomRight.Y:=tmpWin.Height; + Repeat + CalculateWin(tmpWin); + visArea.TopLeft:=MapWinToLonLat(tmpWin,TopLeft); + visArea.BottomRight:=MapWinToLonLat(tmpWin,BottomRight); + if (AreaInsideArea(aArea,visArea)) then + begin + break; + end; + Dec(tmpWin.Zoom); + until (tmpWin.Zoom=2); + MapWin:=tmpWin; + Redraw(MapWin); +end; + +procedure TMapViewerEngine.GetMapProviders(lst: TStrings); +begin + lst.Assign(lstProvider); +end; + +function TMapViewerEngine.LonLatToMapWin(const aWin : TMapWindow;aPt: TRealPoint): TPoint; +var + tiles: Int64; + circumference: Int64; + lat: Extended; + res: Extended; + tmpX,tmpY : Double; +begin + tiles := 1 shl aWin.Zoom; + circumference := tiles * TILE_SIZE; + tmpX := ((aPt.Lon+ 180.0)*circumference)/360.0; + + res := (2 * pi * EARTH_RADIUS) / circumference; + + + tmpY := -aPt.Lat; + tmpY := ln(tan((degToRad(tmpY) + pi / 2.0) / 2)) *180 / pi; + tmpY:= (((tmpY /180.0)*SHIFT)+SHIFT)/res; + + tmpX := tmpX + aWin.X; + tmpY := tmpY + aWin.Y; + Result.X:=trunc(tmpX); + Result.Y:=trunc(tmpY); +End; + +function TMapViewerEngine.MapWinToLonLat(const aWin: TMapWindow; aPt: TPoint): TRealPoint; +var + tiles: Int64; + circumference: Int64; + lat: Extended; + res: Extended; + mPoint : TPoint; +begin + tiles := 1 shl aWin.Zoom; + circumference := tiles * TILE_SIZE; + + mPoint.X := aPt.X - aWin.X; + mPoint.Y := aPt.Y - aWin.Y; + + if mPoint.X < 0 then + mPoint.X := 0 + else + if mPoint.X > circumference then + mPoint.X := circumference; + + if mPoint.Y < 0 then + mPoint.Y := 0 + else + if mPoint.Y > circumference then + mPoint.Y := circumference; + + + Result.Lon := ((mPoint.X * 360.0) / circumference) - 180.0; + + res := (2 * pi * EARTH_RADIUS) / circumference; + lat := ((mPoint.Y * res - SHIFT) / SHIFT) * 180.0; + + lat := radtodeg (2 * arctan( exp( lat * pi / 180.0)) - pi / 2.0); + Result.Lat := -lat; + + if Result.Lat > MAX_LATITUDE then + Result.Lat := MAX_LATITUDE + else + if Result.Lat < MIN_LATITUDE then + Result.Lat := MIN_LATITUDE; + + if Result.Lon > MAX_LONGITUDE then + Result.Lon := MAX_LONGITUDE + else + if Result.Lon < MIN_LONGITUDE then + Result.Lon := MIN_LONGITUDE; +end; + +procedure TMapViewerEngine.CalculateWin(var aWin: TMapWindow); +var + mx, my: Extended; + res: Extended; + px, py: Int64; + +Begin + + mx := aWin.Center.Lon * SHIFT / 180.0; + my := ln( tan((90 - aWin.Center.Lat) * pi / 360.0 )) / (pi / 180.0); + + my := my * SHIFT / 180.0; + + res := (2 * pi * EARTH_RADIUS) / (TILE_SIZE * (1 shl aWin.Zoom)); + px := Round((mx + shift) / res); + py := Round((my + shift) / res); + + aWin.X := aWin.Width div 2 - px; + aWin.Y := aWin.Height div 2 - py; + +end; + +function TMapViewerEngine.IsValidTile(const aWin: TMapWindow;const aTile : TTIleId) : boolean; +var tiles : int64; +begin + tiles := 1 shl aWin.Zoom; + Result:=(aTile.X>=0) and (aTile.X<=tiles-1) and (aTile.Y>=0) and (aTile.Y<=tiles-1); +end; + + +procedure TMapViewerEngine.Redraw(const aWin: TmapWindow); +var TilesVis : TArea; + x,y : Integer; //int64; + Tiles : TTileIdArray; + iTile : Integer; +begin + if not(Active) then + Exit; + Queue.CancelAllJob(self); + TilesVis:=CalculateVisibleTiles(aWin); + SetLength(Tiles,(TilesVis.Bottom-TilesVis.top+1)*(TilesVis.Right-TilesVis.Left+1)); + iTile:=low(Tiles); + For y:=TilesVis.top to TilesVis.Bottom do + For X:=TilesVis.Left to TilesVis.Right do + Begin + Tiles[iTile].X:=X; + Tiles[iTile].Y:=Y; + Tiles[iTile].Z:=aWin.Zoom; + if IsValidTile(aWin,Tiles[iTile]) then + iTile+=1; + end; + SetLength(Tiles,iTile); + if length(Tiles)>0 then + Begin + Queue.AddJob(TLaunchDownloadJob.Create(self,Tiles,aWin),self); + end; +end; + +function TMapViewerEngine.CalculateVisibleTiles(const aWin: TMapWindow): TArea; +var MaxX,MAxY,Startx,StartY : int64; +begin + MaxX := (aWin.Width div TILE_SIZE) + 1; + MaxY := (aWin.Height div TILE_SIZE) + 1; + startX := (-(aWin.X)) div TILE_SIZE; + startY := (-(aWin.Y)) div TILE_SIZE; + Result.Left := startX; + Result.right := startX + MaxX; + Result.top := startY; + Result.bottom := startY + MaxY; +end; + +function TMapViewerEngine.IsCurrentWin(const aWin: TMapWindow): boolean; +begin + Result:=(aWin.Zoom=MapWin.Zoom) and (aWin.Center.Lat=MapWin.Center.Lat) and (aWin.Center.Lon=MapWin.Center.Lon) and (aWin.Width=MapWin.Width) and (aWin.Height=MapWin.Height); +end; + +function TMapViewerEngine.GetTileName(const Id: TTileId): String; +begin + Result:=Inttostr(Id.X)+'.'+inttostr(Id.Y)+'.'+inttostr(Id.Z); +end; + +procedure TMapViewerEngine.evDownload(Data : TObject;Job : TJob); +var Id : TTileId; + Url : String; + Env : TEnvTile; + MapO : TMapProvider; + FStream : TMemoryStream; +Begin + Env:=TEnvTile(Data); + Id:=Env.Tile; + MapO:=Env.Win.MapProvider; + if Assigned(MapO) then + Begin + if not(Cache.InCache(MapO,Id)) then + Begin + if Assigned(FDownloadEngine) then + begin + Url:=MapO.GetUrlForTile(Id); + if Url<>'' then + begin + FStream:=TMemoryStream.Create; + Try + Try + FDownloadEngine.DownloadFile(Url,Fstream); + Cache.Add(MapO,Id,FStream); + except + end; + finally + FreeAndNil(FStream); + end; + end; + end; + end; + end; + if Job.Cancelled then + Exit; + if DrawTitleInGuiThread then + Queue.QueueAsyncCall(@TileDownloaded,PtrInt(Env)) + else + TileDownloaded(PtrInt(Env)); +end; + +procedure TMapViewerEngine.TileDownloaded(Data: PtrInt); +var EnvTile : TEnvTile; + img : TLazIntfImage; + X,Y : integer; +begin + EnvTile:=TEnvTile(Data); + Try + if IsCurrentWin(EnvTile.Win)then + Begin + Cache.GetFromCache(EnvTile.Win.MapProvider,EnvTile.Tile,img); + X := EnvTile.Win.X + EnvTile.Tile.X * TILE_SIZE; // begin of X + Y := EnvTile.Win.Y + EnvTile.Tile.Y * TILE_SIZE; // begin of X + DrawTile(EnvTile.Tile,X,Y,img); + end; + finally + FreeAndNil(EnvTile); + end; +end; + +function TMapViewerEngine.GetLetterSvr(id: integer): String; +Begin + Result:=Char(Ord('a')+id); +end; + +function TMapViewerEngine.GetYahooSvr(id: integer): String; +Begin + Result:=inttostr(id+1); +end; + +function TMapViewerEngine.GetYahooY(const Tile : TTileId): string; +Begin + Result :=inttostr( - (Tile.Y - (1 shl Tile.Z) div 2) - 1); +end; + +function TMapViewerEngine.GetYahooZ(const Tile : TTileId): string; +Begin + result:=inttostr(Tile.Z+1); +end; + +function TMapViewerEngine.GetQuadKey(const Tile : TTileId): string; +var + i, d, m: Longword; +begin + { + Bing Maps Tile System + http://msdn.microsoft.com/en-us/library/bb259689.aspx + } + Result := ''; + for i := Tile.Z downto 1 do + begin + d := 0; + m := 1 shl (i - 1); + if (Tile.x and m) <> 0 then + Inc(d, 1); + if (Tile.y and m) <> 0 then + Inc(d, 2); + Result := Result + IntToStr(d); + end; +end; + +Type + +{ TMemObj } + + TMemObj = Class + private + FWin : TMapWindow; + public + constructor Create(const aWin : TMapWindow); + End; + +{ TMemObj } + +constructor TMemObj.Create(const aWin: TMapWindow); +begin + FWin:=aWin; +end; + + +procedure TMapViewerEngine.MoveMapCenter(Sender: TDragObj); +var old : TMemObj; + nCenter : TRealPoint; + Job : TJob; + aPt : TPoint; +Begin + if Sender.LnkObj=nil then + Begin + Sender.LnkObj:=TMemObj.Create(MapWin); + end; + old:=TMemObj(Sender.LnkObj); + aPt.X:=old.FWin.Width DIV 2-Sender.OfsX; + aPt.Y:=old.FWin.Height DIV 2-Sender.OfsY; + nCenter:=MapWinToLonLat(old.FWin,aPt); + SetCenter(nCenter); +end; + +procedure TMapViewerEngine.SetActive(AValue: boolean); +begin + if FActive=AValue then Exit; + FActive:=AValue; + if not(FActive) then + Queue.CancelAllJob(self) + else + Redraw(MapWin); +end; + +procedure TMapViewerEngine.DoDrag(Sender: TDragObj); +begin + if Sender.DragSrc=self then + Begin + MoveMapCenter(Sender); + end; +end; + +procedure TMapViewerEngine.CancelCurrentDrawing; +var Jobs : TJobArray; +begin + Jobs:=Queue.CancelAllJob(self); + Queue.WaitForTerminate(Jobs); +end; + +procedure TMapViewerEngine.Redraw; +begin + Redraw(MapWin); +end; + + +function TMapViewerEngine.AddMapProvider(OpeName: String; Url: String; + MinZoom : integer;MaxZoom : integer; + NbSvr: integer; GetSvrStr: TGetSvrStr; GetXStr: TGetValStr; + GetYStr: TGetValStr; GetZStr: TGetValStr) : TMapProvider; +var idx :integer; +Begin + idx:=lstProvider.IndexOf(OpeName); + if idx=-1 then + Begin + result:=TMapProvider.Create(OpeName); + lstProvider.AddObject(OpeName,result); + end + else + result:=TMapProvider(lstProvider.Objects[idx]); + result.AddUrl(Url,NbSvr,MinZoom,MaxZoom,GetSvrStr,GetXStr,GetYStr,GetZStr); +end; + +procedure TMapViewerEngine.RegisterProviders; +begin + AddMapProvider('Aucun','',0,30, 0); + { + AddMapProvider('Google Satellite','http://khm%d.google.com/kh/v=82&x=%x%&y=%y%&z=%z%&s=Ga',4); + AddMapProvider('Google Hybrid','http://khm%d.google.com/kh/v=82&x=%x%&y=%y%&z=%z%&s=Ga',4); + AddMapProvider('Google Hybrid','http://mt%d.google.com/vt/lyrs=h@145&v=w2.104&x=%d&y=%d&z=%z%',4); + AddMapProvider('Google physical','http://mt%d.google.com/vt/lyrs=t@145&v=w2.104&x=%d&y=%d&z=%z%',4); + AddMapProvider('Google Physical Hybrid','http://mt%d.google.com/vt/lyrs=t@145&v=w2.104&x=%x%&y=%y%&z=%z%',4); + AddMapProvider('Google Physical Hybrid','http://mt%d.google.com/vt/lyrs=h@145&v=w2.104&x=%x%&y=%y%&z=%z%',4);} + //AddMapProvider('OpenStreetMap Osmarender','http://%serv%.tah.openstreetmap.org/Tiles/tile/%z%/%x%/%y%.png',0,20,3, @getLetterSvr); // [Char(Ord('a')+Random(3)), Z, X, Y])); + //AddMapProvider('Yahoo Normal','http://maps%serv%.yimg.com/hx/tl?b=1&v=4.3&.intl=en&x=%x%&y=%y%d&z=%d&r=1' , 0,20,3,@GetYahooSvr, nil, @getYahooY, @GetYahooZ); //(Z+1])); + //AddMapProvider('Yahoo Satellite','http://maps%serv%.yimg.com/ae/ximg?v=1.9&t=a&s=256&.intl=en&x=%d&y=%d&z=%d&r=1', 0,20,3,@GetYahooSvr, nil, @getYahooY, @GetYahooZ); //[Random(3)+1, X, YahooY(Y), Z+1])); + //AddMapProvider('Yahoo Hybrid','http://maps%serv%.yimg.com/ae/ximg?v=1.9&t=a&s=256&.intl=en&x=%x%&y=%y%&z=%z%&r=1', 0,20,3,@GetYahooSvr, nil, @getYahooY, @GetYahooZ); //[Random(3)+1, X, YahooY(Y), Z+1])); + //AddMapProvider('Yahoo Hybrid','http://maps%serv%.yimg.com/hx/tl?b=1&v=4.3&t=h&.intl=en&x=%x%&y=%y%&z=%z%&r=1' , 0,20,3,@GetYahooSvr, nil, @getYahooY, @GetYahooZ); //[Random(3)+1, X, YahooY(Y), Z+1])); + + MapWin.MapProvider:=AddMapProvider('OpenStreetMap Mapnik','http://%serv%.tile.openstreetmap.org/%z%/%x%/%y%.png',0,19, 3, @getLetterSvr); + AddMapProvider('Open Cycle Map','http://%serv%.tile.opencyclemap.org/cycle/%z%/%x%/%y%.png',0,18,3, @getLetterSvr); + AddMapProvider('Virtual Earth Bing','http://ecn.t%serv%.tiles.virtualearth.net/tiles/r%x%?g=671&mkt=en-us&lbl=l1&stl=h&shading=hill',1,19,8,nil,@GetQuadKey); + AddMapProvider('Virtual Earth Road','http://r%serv%.ortho.tiles.virtualearth.net/tiles/r%x%.png?g=72&shading=hill',1,19,4,nil,@getQuadKey); + AddMapProvider('Virtual Earth Aerial','http://a%serv%.ortho.tiles.virtualearth.net/tiles/a%x%.jpg?g=72&shading=hill',1,19,4,nil,@getQuadKey); + AddMapProvider('Virtual Earth Hybrid','http://h%serv%.ortho.tiles.virtualearth.net/tiles/h%x%.jpg?g=72&shading=hill',1,19,4,nil,@getQuadKey); + AddMapProvider('Ovi Normal', 'http://%serv%.maptile.maps.svc.ovi.com/maptiler/v2/maptile/newest/normal.day/%z%/%x%/%y%/256/png8', 0,20,5,@getLetterSvr); + AddMapProvider('Ovi Satellite','http://%serv%.maptile.maps.svc.ovi.com/maptiler/v2/maptile/newest/satellite.day/%z%/%x%/%y%/256/png8', 0,20,5,@getLetterSvr); + AddMapProvider('Ovi Hybrid','http://%serv%.maptile.maps.svc.ovi.com/maptiler/v2/maptile/newest/hybrid.day/%z%/%x%/%y%/256/png8', 0,20,5,@getLetterSvr); + AddMapProvider('Ovi Physical','http://%serv%.maptile.maps.svc.ovi.com/maptiler/v2/maptile/newest/terrain.day/%z%/%x%/%y%/256/png8', 0,20,5,@getLetterSvr); +end; + +procedure TMapViewerEngine.DrawTile(const TileId : TTileId;X, Y: integer; TileImg: TLazIntfImage); +begin + if Assigned(FOnDrawTile) then + FOnDrawTile(TileId,X,Y,TileImg); +end; + +constructor TMapViewerEngine.Create(aOwner: TComponent); +begin + DrawTitleInGuiThread := true; + DragObj := TDragObj.Create; + DragObj.OnDrag:=@DoDrag; + Cache := TPictureCache.Create(self); + lstProvider:=TStringList.Create; + RegisterProviders; + Queue:=TJobQueue.Create(8); + Queue.OnIdle:= @Cache.CheckCacheSize; + inherited Create(aOwner); + ConstraintZoom(MapWin); + CalculateWin(mapWin); +end; + +destructor TMapViewerEngine.Destroy; +var + i: Integer; +begin + FreeAndNil(DragObj); + for i:=0 to lstProvider.Count-1 do + TObject(lstProvider.Objects[i]).Free; + FreeAndNil(lstProvider); + FreeAndNil(Cache); + FreeAndNil(Queue); + inherited Destroy; +end; + +end. + diff --git a/components/lazmapviewer/source/mvextradata.pas b/components/lazmapviewer/source/mvextradata.pas new file mode 100644 index 000000000..bc4876705 --- /dev/null +++ b/components/lazmapviewer/source/mvextradata.pas @@ -0,0 +1,43 @@ +unit mvextradata; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils,graphics; + +type + + { TDrawingExtraData } + + TDrawingExtraData = class + private + FColor: TColor; + FId: integer; + procedure SetColor(AValue: TColor); + public + constructor Create(aId : integer);virtual; + property Color : TColor read FColor write SetColor; + property Id : integer read FId; + End; + +implementation + +{ TDrawingExtraData } + + +procedure TDrawingExtraData.SetColor(AValue: TColor); +begin + if FColor=AValue then Exit; + FColor:=AValue; +end; + +constructor TDrawingExtraData.Create(aId: integer); +begin + FId:=aId; + FColor:=clRed; +end; + +end. + diff --git a/components/lazmapviewer/source/mvgeonames.pas b/components/lazmapviewer/source/mvgeonames.pas new file mode 100644 index 000000000..a34de8dd9 --- /dev/null +++ b/components/lazmapviewer/source/mvgeonames.pas @@ -0,0 +1,197 @@ +{ Map Viewer Geolocation Engine for geonames.org + + 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. +} +unit mvGeoNames; + +interface + +uses + SysUtils, Classes, StrUtils, + mvTypes, mvDownloadEngine; + +type + TNameFoundEvent = procedure (const AName: string; const ADescr: String; + const ALoc: TRealPoint) of object; + + TStringArray = array of string; + + { TMVGeoNames } + + TMVGeoNames = class(TComponent) + private + FLocationName: string; + FOnNameFound: TNameFoundEvent; + function RemoveTag(const str: String): TStringArray; + public + function DoSearch(dl : TCustomDownloadEngine): TRealPoint; + published + property LocationName: string read FLocationName write FLocationName; + property OnNameFound : TNameFoundEvent read FOnNameFound write FOnNameFound; + end; + +procedure Register; + + +implementation + +function CleanLocationName(x: string): string; +var + i: Integer; +begin + Result := ''; + for i := 1 to Length(x) do + begin + if x[i] in ['A'..'Z', 'a'..'z', '0'..'9'] then + Result := Result + x[i] + else + Result := Result + '+' + end; +end; + +{ TMVGeoNames } + +Type + TResRec = record + Name : String; + Descr : String; + Loc : TRealPoint; + End; + +procedure Register; +begin + RegisterComponents('Maps',[TMVGeoNames]); +end; + +function TMVGeoNames.RemoveTag(Const str : String) : TStringArray; +var iStart,iEnd,i : Integer; + tmp : String; + lst : TStringList; +Begin + SetLength(Result,0); + tmp:=StringReplace(str,'<br>',#13,[rfReplaceall]); + tmp:=StringReplace(tmp,' ',' ',[rfReplaceall]); + tmp:=StringReplace(tmp,' ',' ',[rfReplaceall]); + repeat + iEnd:=-1; + iStart:=pos('<',tmp); + if iStart>0 then + Begin + iEnd:=posEx('>',tmp,iStart); + if iEnd>0 then + Begin + tmp:=copy(tmp,1,iStart-1)+copy(tmp,iEnd+1,length(tmp)); + end; + end; + until iEnd<=0; + lst:=TStringList.Create; + try + lst.Text:=tmp; + SetLEngth(Result,lst.Count); + For i:=0 to pred(lst.Count) do + Result[i]:=trim(lst[i]); + finally + freeAndNil(lst); + end; + +end; + +function TMVGeoNames.DoSearch(dl: TCustomDownloadEngine): TRealPoint; +const + LAT_ID = '<span class="latitude">'; + LONG_ID = '<span class="longitude">'; +var + s: string; + + function gs(id: string;Start : integer): string; + var + i: Integer; + ln: Integer; + begin + Result := ''; + ln := Length(s); + i := PosEx(id, s,start) + Length(id); + while (s[i] <> '<') and (i < ln) do + begin + if s[i] = '.' then + Result := Result + DecimalSeparator + else + Result := Result + s[i]; + Inc(i); + end; + end; + +var + m: TMemoryStream; + iRes,i : integer; + lstRes : Array of TResRec; + iStartDescr : integer; + lst : TStringArray; +begin + m := TMemoryStream.Create; + try + dl.DownloadFile('http://www.geonames.org/search.html?q='+ + CleanLocationName(FLocationName), m); + m.Position := 0; + SetLength(s, m.Size); + m.Read(s[1], m.Size); + finally + m.Free; + end; + + Result.Lon := 0; + Result.Lat:=0; + SetLength(lstRes,0); + iRes:=Pos('<span class="geo"',s); + while (iRes>0) do + 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); + if iStartDescr>0 then + 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 + 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; + + if length(lstRes)>0 then + 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 + FOnNameFound(lstRes[iRes].Name,lstRes[iRes].Descr,lstRes[iRes].Loc); + end; + End; + +end; + +end. diff --git a/components/lazmapviewer/source/mvgpsobj.pas b/components/lazmapviewer/source/mvgpsobj.pas new file mode 100644 index 000000000..87ebd84be --- /dev/null +++ b/components/lazmapviewer/source/mvgpsobj.pas @@ -0,0 +1,728 @@ +{ Map Viewer - basic gps object + + Copyright (C) 2014 ti_dic@hotmail.com + + 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. +}unit mvgpsobj; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils,fgl,mvtypes,contnrs,syncobjs; +const + NO_ELE = -10000000; + NO_DATE = 0; +type + TIdArray = Array of integer; + + { TGPSObj } + + TGPSObj = Class + private + BBoxSet : Boolean; + FBoundingBox : TRealArea; + FExtraData: TObject; + FName: String; + FIdOwner : integer; + function GetBoundingBox: TRealArea; + procedure SetBoundingBox(AValue: TRealArea); + procedure SetExtraData(AValue: TObject); + public + destructor Destroy;override; + Procedure GetArea(out Area : TRealArea);virtual;abstract; + property Name : String read FName write FName; + property ExtraData : TObject read FExtraData write SetExtraData; + property BoundingBox : TRealArea read GetBoundingBox write SetBoundingBox; + + end; + + TGPSObjarray = Array of TGPSObj; + + { TGPSPoint } + + TGPSPoint = Class(TGPSObj) + private + FRealPt : TRealPoint; + FEle : Double; + FDateTime : TDateTime; + function GetLat: Double; + function GetLon: Double; + public + Procedure GetArea(out Area : TRealArea);override; + Function HasEle : boolean; + Function HasDateTime : Boolean; + Function DistanceInKmFrom(OtherPt : TGPSPoint;UseEle : boolean=true) : double; + constructor Create(ALon,ALat : double;AEle : double=NO_ELE;ADateTime : TDateTime=NO_DATE); + Class function CreateFrom(aPt : TRealPoint) : TGPSPoint; + + property Lon : Double read GetLon; + property Lat : Double read GetLat; + property Ele : double read FEle; + property DateTime : TDateTime read FDateTime; + property RealPoint : TRealPoint read FRealPt; + end; + + TGPSPointList = specialize TFPGObjectList<TGPSPoint>; + + { TGPSTrack } + + TGPSTrack = Class(TGPSObj) + private + FDateTime: TDateTime; + FPoints : TGPSPointList; + function GetDateTime: TDateTime; + public + constructor Create; + destructor Destroy;override; + + Procedure GetArea(out Area : TRealArea);override; + Function TrackLengthInKm(UseEle : Boolean=true) : double; + + property Points : TGPSPointList read FPoints; + property DateTime : TDateTime read GetDateTime write FDateTime; + end; + + TGPSObjList_ = specialize TFPGObjectList<TGPSObj>; + + { TGPSObjList } + + TGPSObjList = class(TGPSObjList_) + private + FRef : TObject; + public + Destructor Destroy;override; + end; + + { TGPSObjectList } + TModifiedEvent = procedure (Sender : TObject;objs : TGPSObjList;Adding : boolean) of object; + + TGPSObjectList = Class(TGPSObj) + private + Crit:TCriticalSection; + FPending : TObjectList; + FRefCount : integer; + FOnModified: TModifiedEvent; + FUpdating : integer; + FItems : TGPSObjList; + function Getcount: integer; + protected + Procedure _Delete(Idx : Integer;out DelLst : TGPSObjList); + Procedure FreePending; + Procedure DecRef; + procedure Lock; + procedure UnLock; + procedure CallModified(lst : TGPSObjList;Adding : boolean); + property Items : TGPSObjList read FItems; + procedure IdsToObj(const Ids : TIdArray;out objs : TGPSObjArray;IdOwner : integer); + public + Procedure GetArea(out Area : TRealArea);override; + function GetObjectsInArea(const Area: TRealArea): TGPSObjList; + constructor Create; + destructor Destroy;override; + Procedure Clear(OwnedBy : integer); + procedure ClearExcept(OwnedBy : integer;const ExceptLst : TIdArray;out Notfound : TIdArray); + function GetIdsArea(const Ids : TIdArray;IdOwner : integer) : TRealArea; + + function Add(aItem : TGpsObj;IdOwner : integer) : integer; + Procedure DeleteById(const Ids : Array of integer); + + Procedure BeginUpdate; + Procedure EndUpdate; + + property Count : integer read Getcount; + property OnModified : TModifiedEvent read FOnModified write FOnModified; + end; + + function hasIntersectArea(const Area1 : TRealArea;const Area2 : TRealArea) : boolean; + function IntersectArea(const Area1 : TRealArea;const Area2 : TRealArea) : TRealArea; + function PtInsideArea(const aPoint : TRealPoint;const Area : TRealArea) : boolean; + Function AreaInsideArea(const AreaIn : TRealArea;const AreaOut : TRealArea) : boolean; + Procedure ExtendArea(var AreaToExtend : TRealArea;Const Area : TRealArea); + Function GetAreaOf(objs : TGPSObjList) : TRealArea; + + +implementation +uses mvextradata; + +function hasIntersectArea(const Area1: TRealArea; const Area2: TRealArea): boolean; +begin + Result:=(Area1.TopLeft.Lon<=Area2.BottomRight.Lon) and (Area1.BottomRight.Lon>=Area2.TopLeft.Lon) and + (Area1.TopLeft.Lat>=Area2.BottomRight.Lat) and (Area1.BottomRight.Lat<=Area2.TopLeft.Lat); +end; + +function IntersectArea(const Area1: TRealArea; const Area2: TRealArea + ): TRealArea; +begin + Result:=Area1; + if Result.TopLeft.Lon<Area2.topLeft.Lon then + Result.TopLeft.Lon:=Area2.topLeft.Lon; + if Result.TopLeft.Lat>Area2.topLeft.Lat then + Result.TopLeft.Lat:=Area2.topLeft.Lat; + if Result.BottomRight.Lon>Area2.BottomRight.Lon then + Result.BottomRight.Lon:=Area2.BottomRight.Lon; + if Result.BottomRight.Lat<Area2.BottomRight.Lat then + Result.BottomRight.Lat:=Area2.BottomRight.Lat; +end; + +function PtInsideArea(const aPoint: TRealPoint; const Area: TRealArea): boolean; +begin + Result:=(Area.TopLeft.Lon<=aPoint.Lon) and (Area.BottomRight.Lon>=aPoint.Lon) and + (Area.TopLeft.Lat>=aPoint.Lat) and (Area.BottomRight.Lat<=aPoint.Lat); +end; + +function AreaInsideArea(const AreaIn: TRealArea; const AreaOut: TRealArea + ): boolean; +begin + Result:=(AreaIn.TopLeft.Lon>=AreaOut.TopLeft.Lon) and (AreaIn.BottomRight.Lon<=AreaOut.BottomRight.Lon) and + (AreaOut.TopLeft.Lat>=AreaIn.TopLeft.Lat) and (AreaOut.BottomRight.Lat<=AreaIn.BottomRight.Lat); +end; + +procedure ExtendArea(var AreaToExtend: TRealArea; const Area: TRealArea); +begin + if AreaToExtend.TopLeft.Lon>Area.TopLeft.Lon then + AreaToExtend.TopLeft.Lon:=Area.TopLeft.Lon; + if AreaToExtend.BottomRight.Lon<Area.BottomRight.Lon then + AreaToExtend.BottomRight.Lon:=Area.BottomRight.Lon; + + if AreaToExtend.TopLeft.Lat<Area.TopLeft.Lat then + AreaToExtend.TopLeft.Lat:=Area.TopLeft.Lat; + if AreaToExtend.BottomRight.Lat>Area.BottomRight.Lat then + AreaToExtend.BottomRight.Lat:=Area.BottomRight.Lat; +end; + +function GetAreaOf(objs: TGPSObjList): TRealArea; +var i : integer; +begin + Result.TopLeft.Lon:=0; + Result.TopLeft.Lat:=0; + Result.BottomRight.Lon:=0; + Result.BottomRight.Lat:=0; + if Objs.Count>0 then + Begin + Result:=Objs[0].BoundingBox; + For i:=1 to pred(Objs.Count) do + ExtendArea(Result,Objs[i].BoundingBox); + end; +end; + +{ TGPSObjList } + +destructor TGPSObjList.Destroy; +begin + if Assigned(FRef) then + TGPSObjectList(FRef).DecRef; + inherited Destroy; +end; + +{ TGPSObj } + +procedure TGPSObj.SetExtraData(AValue: TObject); +begin + if FExtraData=AValue then Exit; + if Assigned(FExtraData) then + FreeAndNil(FExtraData); + FExtraData:=AValue; +end; + +function TGPSObj.GetBoundingBox: TRealArea; +begin + if not(BBoxSet) then + Begin + GetArea(FBoundingBox); + BBoxSet:=true; + end; + Result:=FBoundingBox; +end; + +procedure TGPSObj.SetBoundingBox(AValue: TRealArea); +begin + FBoundingBox:=AValue; + BBoxSet:=true; +end; + +destructor TGPSObj.Destroy; +begin + FreeAndNil(FExtraData); + inherited Destroy; +end; + +{ TGPSObjectList } + +function TGPSObjectList.Getcount: integer; +begin + Result:=FItems.Count +end; + +procedure TGPSObjectList._Delete(Idx: Integer; out DelLst: TGPSObjList); +var Item : TGpsObj; +begin + Lock; + Try + if not(Assigned(DelLst)) then + Begin + DelLst:=TGpsObjList.Create(False); + DelLst.FRef:=Self; + inc(FRefCount); + end; + if not Assigned(FPending) then + FPending:=TObjectList.Create(true); + Item:=Items.Extract(Items[Idx]); + FPending.Add(Item); + finally + UnLock; + end; + DelLst.Add(Item); +end; + +procedure TGPSObjectList.FreePending; +begin + if Assigned(FPending) then + Begin + Lock; + Try + FreeAndNil(FPending); + finally + UnLock; + end; + end; +end; + +procedure TGPSObjectList.DecRef; +begin + FRefCount-=1; + if FRefCount=0 then + FreePending; +end; + +procedure TGPSObjectList.Lock; +begin + if Assigned(Crit) then + Crit.Enter; +end; + +procedure TGPSObjectList.UnLock; +begin + if Assigned(Crit) then + Crit.Leave; +end; + +procedure TGPSObjectList.CallModified(lst: TGPSObjList; Adding: boolean); +begin + if (FUpdating=0) and Assigned(FOnModified) then + FOnModified(self,lst,Adding) + else + lst.Free; +end; + +procedure TGPSObjectList.IdsToObj(const Ids: TIdArray; out objs: TGPSObjArray;IdOwner : integer); + +function ToSelect(aId : integer) : boolean; +var i : integer; +begin + result:=false; + for i:=low(Ids) to high(Ids) do + if Ids[i]=aId then + begin + result:=true; + break; + end; +end; + +var i,nb : integer; +begin + SetLength(objs,length(Ids)); + nb:=0; + Lock; + Try + for i:=0 to pred(FItems.Count) do + begin + if (IdOwner=0) or (IdOwner=FItems[i].FIdOwner) then + if Assigned(FItems[i].ExtraData) and FItems[i].ExtraData.InheritsFrom(TDrawingExtraData) then + Begin + if ToSelect(TDrawingExtraData(FItems[i].ExtraData).Id) then + Begin + objs[nb]:=FItems[i]; + nb+=1; + end; + end; + end; + finally + Unlock; + end; + SetLength(objs,nb); +end; + +procedure TGPSObjectList.GetArea(out Area: TRealArea); +var i : integer; + ptArea : TRealArea; +begin + Area.BottomRight.lon:=0; + Area.BottomRight.lat:=0; + Area.TopLeft.lon:=0; + Area.TopLeft.lat:=0; + Lock; + Try + if Items.Count>0 then + begin + Area:=Items[0].BoundingBox; + for i:=1 to pred(Items.Count) do + begin + ptArea:=Items[i].BoundingBox; + ExtendArea(Area,ptArea); + end; + end; + finally + Unlock; + end; +end; + +function TGPSObjectList.GetObjectsInArea(const Area: TRealArea): TGPSObjList; +var i : integer; + ItemArea : TRealArea; +begin + Result:=TGPSObjList.Create(false); + Lock; + Try + Inc(FRefCount); + For i:=0 to pred(Items.Count) do + Begin + ItemArea:=Items[i].BoundingBox; + If hasIntersectArea(Area,ItemArea) then + Result.Add(Items[i]); + end; + if Result.Count>0 then + Result.FRef:=Self + else + Dec(FRefCount); + finally + Unlock; + end; +end; + +constructor TGPSObjectList.Create; +begin + Crit:=TCriticalSection.Create; + FItems := TGPSObjList.Create(true); +end; + +destructor TGPSObjectList.Destroy; +begin + inherited Destroy; + FreeAndNil(FItems); + FreeAndNil(FPending); + FreeAndNil(Crit); +end; + +procedure TGPSObjectList.Clear(OwnedBy: integer); +var i : integer; + DelObj : TGPSObjList; +begin + DelObj:=nil; + Lock; + try + For i:=pred(FItems.Count) downto 0 do + if (OwnedBy=0) or (FItems[i].FIdOwner=OwnedBy) then + _Delete(i,DelObj); + finally + Unlock; + end; + if Assigned(DelObj) then + CallModified(DelObj,false); +end; + +procedure TGPSObjectList.ClearExcept(OwnedBy: integer; + const ExceptLst : TIdArray; out Notfound: TIdArray); + +var Found : TIdArray; + +function ToDel(aIt : TGPsObj) : boolean; +var i,Id : integer; +Begin + if (aIt.ExtraData=nil) or not(aIt.ExtraData.InheritsFrom(TDrawingExtraData)) then + result:=true + else + Begin + Result:=true; + Id:=TDrawingExtraData(aIt.ExtraData).Id; + for i:=low(ExceptLst) to high(ExceptLst) do + if Id=ExceptLst[i] then + begin + result:=false; + SetLength(Found,Length(Found)+1); + Found[high(Found)]:=Id; + exit; + end; + end; +end; + +var i,j : integer; + IsFound : boolean; + DelLst : TGPSObjList; +begin + DelLst:=nil; + SetLength(NotFound,0); + SetLength(Found,0); + Lock; + try + For i:=pred(FItems.Count) downto 0 do + begin + if (FItems[i].FIdOwner=OwnedBy) or (OwnedBy=0) then + Begin + if ToDel(FItems[i]) then + _Delete(i,DelLst); + end; + end; + finally + Unlock; + end; + For i:=low(ExceptLst) to high(ExceptLst) do + Begin + IsFound:=false; + for j:=low(Found) to high(Found) do + if Found[j]=ExceptLst[i] then + begin + IsFound:=true; + break; + end; + if not(IsFound) then + Begin + SetLength(NotFound,length(NotFound)+1); + NotFound[high(NotFound)]:=ExceptLst[i]; + end; + end; + if Assigned(DelLst) then + CallModified(DelLst,false); +end; + +function TGPSObjectList.GetIdsArea(const Ids: TIdArray;IdOwner : integer): TRealArea; +var Objs : TGPSObjarray; + i : integer; +begin + Result.BottomRight.Lat:=0; + Result.BottomRight.Lon:=0; + Result.TopLeft.Lat:=0; + Result.TopLeft.Lon:=0; + Lock; + Try + IdsToObj(Ids,Objs,IdOwner); + if length(Objs)>0 then + Begin + Result:=Objs[0].BoundingBox; + for i:=succ(low(Objs)) to high(Objs) do + begin + ExtendArea(Result,Objs[i].BoundingBox); + end; + end; + finally + Unlock; + end; +end; + +function TGPSObjectList.Add(aItem: TGpsObj;IdOwner : integer): integer; +var mList : TGPSObjList; +begin + aItem.FIdOwner:=IdOwner; + Lock; + try + Result:=Items.Add(aItem); + mList:=TGPSObjList.Create(false); + mList.Add(aItem); + inc(FRefCount); + mList.FRef:=Self; + finally + Unlock; + end; + CallModified(mList,true); +end; + +procedure TGPSObjectList.DeleteById(const Ids: array of integer); +function ToDelete(const AId : integer) : Boolean; +var i : integer; +begin + result:=false; + For i:=low(Ids) to high(Ids) do + if Ids[i]=AId then + Begin + result:=true; + exit; + end; +end; + +var Extr : TDrawingExtraData; + i : integer; + DelLst : TGPSObjList; +begin + DelLst:=nil; + Lock; + try + For i:=Pred(Items.Count) downto 0 do + Begin + if Assigned(Items[i].ExtraData) then + Begin + if Items[i].ExtraData.InheritsFrom(TDrawingExtraData) then + Begin + Extr := TDrawingExtraData(Items[i]); + if ToDelete(Extr.Id) then + _Delete(i,DelLst); + end; + end; + end; + finally + Unlock; + end; + if Assigned(DelLst) then + +end; + +procedure TGPSObjectList.BeginUpdate; +begin + inc(FUpdating); +end; + +procedure TGPSObjectList.EndUpdate; +begin + if FUpdating>0 then + begin + Dec(FUpdating); + if FUpdating=0 then + CallModified(nil,true); + end; +end; + +{ TGPSTrack } + +function TGPSTrack.GetDateTime: TDateTime; +begin + if FDateTime=0 then + Begin + if FPoints.Count>0 then + FDateTime:=FPoints[0].DateTime; + end; + Result:=FDateTime; +end; + +constructor TGPSTrack.Create; +begin + FPoints := TGPSPointList.Create(true); +end; + +destructor TGPSTrack.Destroy; +begin + inherited Destroy; + FreeAndNil(FPoints); +end; + +procedure TGPSTrack.GetArea(out Area: TRealArea); +var i : integer; + ptArea : TRealArea; +begin + Area.BottomRight.lon:=0; + Area.BottomRight.lat:=0; + Area.TopLeft.lon:=0; + Area.TopLeft.lat:=0; + if FPoints.Count>0 then + begin + Area:=FPoints[0].BoundingBox; + for i:=1 to pred(FPoints.Count) do + begin + ptArea:=FPoints[i].BoundingBox; + ExtendArea(Area,ptArea); + end; + end; +end; + +function TGPSTrack.TrackLengthInKm(UseEle: Boolean): double; +var i : integer; +begin + Result:=0; + For i:=1 to pred(FPoints.Count) do + begin + result+=FPoints[i].DistanceInKmFrom(FPoints[pred(i)],UseEle); + end; +end; + +{ TGPSPoint } + +function TGPSPoint.GetLat: Double; +begin + result:=FRealPt.Lat; +end; + +function TGPSPoint.GetLon: Double; +begin + result:=FRealPt.Lon; +end; + +procedure TGPSPoint.GetArea(out Area: TRealArea); +begin + Area.TopLeft:=FRealPt; + Area.BottomRight:=FRealPt; +end; + +function TGPSPoint.HasEle: boolean; +begin + Result:=FEle<>NO_ELE; +end; + +function TGPSPoint.HasDateTime: Boolean; +begin + Result:=FDateTime<>NO_DATE; +end; + +function TGPSPoint.DistanceInKmFrom(OtherPt: TGPSPoint;UseEle : boolean): double; +var a : double; + lat1,lat2,lon1,lon2,t1,t2,t3,t4,t5,rad_dist : double; + DiffEle :Double; +begin + a := PI / 180; + lat1 := lat * a; + lat2 := OtherPt.lat * a; + lon1 := lon * a; + lon2 := OtherPt.lon * a; + + t1 := sin(lat1) * sin(lat2); + t2 := cos(lat1) * cos(lat2); + t3 := cos(lon1 - lon2); + t4 := t2 * t3; + t5 := t1 + t4; + rad_dist := arctan(-t5/sqrt(-t5 * t5 +1)) + 2 * arctan(1); + result := (rad_dist * 3437.74677 * 1.1508) * 1.6093470878864446; + if UseEle and (FEle<>OtherPt.FEle) then + if (HasEle) and (OtherPt.HasEle) then + Begin + //FEle is assumed in Metter + DiffEle:=(FEle-OtherPt.Ele)/1000; + Result:=sqrt(DiffEle*DiffEle+result*result); + end; +end; + +constructor TGPSPoint.Create(ALon, ALat: double; AEle: double; + ADateTime: TDateTime); +begin + FRealPt.Lon:=ALon; + FRealPt.Lat:=ALat; + FEle:=AEle; + FDateTime:=ADateTime; +end; + +class function TGPSPoint.CreateFrom(aPt: TRealPoint): TGPSPoint; +begin + Result:=Create(aPt.Lon,aPt.Lat); +end; + +end. + diff --git a/components/lazmapviewer/source/mvjobqueue.pas b/components/lazmapviewer/source/mvjobqueue.pas new file mode 100644 index 000000000..ac806fcff --- /dev/null +++ b/components/lazmapviewer/source/mvjobqueue.pas @@ -0,0 +1,803 @@ +{ + Multi thread Queue,witch can be used without multi-thread (c) 2014 ti_dic + + 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. +} +unit mvJobQueue; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils,syncobjs,contnrs,forms; + +const ALL_TASK_COMPLETED = -1; + NO_MORE_TASK = 0; + +type + TjobQueue = class; + + { TJob } + + TJob = Class + private + FLauncher : TObject; + FCancelled : Boolean; + FName: String; + protected + Queue : TJobQueue; + + procedure DoCancel;virtual; + Procedure WaitForResultOf(aJob : TJob); + Procedure EnterCriticalSection; + procedure LeaveCriticalSection; + + //should be called inside critical section + function pGetTask : integer;virtual; + procedure pTaskStarted(aTask: integer);virtual;abstract; + procedure pTaskEnded(aTask : integer;aExcept : Exception);virtual;abstract; + property Launcher : TObject read FLauncher; + public + procedure ExecuteTask(aTask : integer;FromWaiting : boolean);virtual;abstract; + function Running : boolean;virtual;abstract; + procedure Cancel; + property Cancelled : boolean read FCancelled; + property Name : String read FName write FName; + end; + + TJobArray = Array of TJob; + + { TjobQueue } + + TjobQueue = Class + private + FMainThreadId : TThreadID; + FOnIdle: TNotifyEvent; + waitings : TStringList; + FNbThread : integer; + TerminatedThread : integer; + FSect : TCriticalSection; + FEvent,TerminateEvent : TEvent; + FUseThreads: boolean; + Threads : TList; + Jobs : TObjectList; + procedure pJobCompleted(var aJob: TJob); + procedure SetUseThreads(AValue: boolean); + procedure ClearWaitings; + protected + Procedure InitThreads; + Procedure FreeThreads; + Procedure EnterCriticalSection; + procedure LeaveCriticalSection; + Procedure DoWaiting(E : Exception;TaskId : integer); + + //Should be called inside critical section + procedure pAddWaiting(aJob : TJob;aTask : integer;JobId : String); + procedure pTaskStarted(aJob : TJob;aTask : integer); + procedure pTaskEnded(var aJob : TJob;aTask : integer;aExcept : Exception); + function pGetJob(out TaskId : integer;out Restart : boolean) : TJob; + function pFindJobByName(const aName : string;ByLauncher: TObject) : TJobArray; + procedure pNotifyWaitings(aJob : TJob); + Function IsMainThread : boolean; + public + constructor Create(NbThread : integer = 5); + destructor Destroy;override; + procedure QueueAsyncCall(const AMethod: TDataEvent; Data: PtrInt); + procedure QueueSyncCall(const AMethod: TDataEvent; Data: PtrInt); + property UseThreads : boolean read FUseThreads write SetUseThreads; + Procedure AddJob(aJob : TJob;Launcher : TObject); + function AddUniqueJob(aJob : TJob;Launcher : TObject) : boolean; + function CancelAllJob(ByLauncher: TObject) : TJobArray; + function CancelJobByName(aJobName : String;ByLauncher: TObject) : boolean; + Procedure WaitForTerminate(const lstJob : TJobArray); + Procedure WaitAllJobTerminated(ByLauncher: TObject); + property OnIdle : TNotifyEvent read FOnIdle write FOnIdle; + end; + + +implementation +const + WAIT_TIME = 3000; + TERMINATE_TIMEOUT = 1000; + + +Type + + { EWaiting } + + EWaiting = Class(Exception) + private + FLauncher : TJob; + FNewJob : TJob; + public + constructor Create(launcher : TJob;NewJob : TJob); + end; + + { TRestartTask } + + TRestartTask = Class(TJob) + private + FStarted : Boolean; + FJob : TJob; + FTask : integer; + protected + procedure DoCancel;override; + procedure pTaskStarted(aTask: integer);override; + procedure pTaskEnded(aTask : integer;aExcept : Exception);override; + function pGetTask : integer;override; + public + constructor Create(aJob : TJob;aTask : integer); + procedure ExecuteTask(aTask : integer;FromWaiting : boolean);override; + function Running : boolean;override; + end; + + { TQueueThread } + + TQueueThread = Class(TThread) + private + MyQueue : TJobqueue; + function ProcessJob : boolean; + public + constructor Create(aQueue: TJobQueue); + procedure Execute; override; + end; + +{ TRestartTask } + +procedure TRestartTask.DoCancel; +begin + FJob.Cancel; +end; + +procedure TRestartTask.pTaskStarted(aTask: integer); +begin + FStarted := true; +end; + +procedure TRestartTask.pTaskEnded(aTask: integer; aExcept: Exception); +begin + Queue.pTaskEnded(FJob,FTask,aExcept); +end; + +function TRestartTask.pGetTask: integer; +begin + if FStarted then + Result:=inherited pGetTask + else + Result:=1; +end; + +constructor TRestartTask.Create(aJob: TJob; aTask: integer); +begin + FJob:=aJob; + FTask:=aTask; +end; + +procedure TRestartTask.ExecuteTask(aTask: integer; FromWaiting: boolean); +begin + FJob.ExecuteTask(FTask,true); +end; + +function TRestartTask.Running: boolean; +begin + Result:=Fstarted; +end; + +{ EWaiting } + +constructor EWaiting.Create(launcher: TJob; NewJob: TJob); +begin + FLauncher:=launcher; + FNewJob:=NewJob; +end; + +{ TQueueThread } + +function TQueueThread.ProcessJob : boolean; +var aJob : TJob; + TaskId : Integer; + + Procedure SetRes(e : Exception); + Begin + MyQueue.EnterCriticalSection; + Try + MyQueue.pTaskEnded(aJob,TaskId,nil); + finally + MyQueue.LeaveCriticalSection; + end; + end; +var RestartTask : boolean; + SomeJob : Boolean; +begin + Result:=false; + Repeat + SomeJob:=false; + MyQueue.EnterCriticalSection; + Try + result:=result or (MyQueue.Jobs.Count>0); + aJob:=MyQueue.pGetJob(TaskId,RestartTask); + if Assigned(aJob) then + Begin + if TaskId=ALL_TASK_COMPLETED then + begin + MyQueue.pJobCompleted(aJob); + SomeJob := true; + end + else + Begin + MyQueue.FEvent.ResetEvent; + if not(RestartTask) then + MyQueue.pTaskStarted(aJob,TaskId); + end; + end; + finally + MyQueue.LeaveCriticalSection; + end; + if Assigned(aJob) then + Begin + SomeJob:=true; + Try + aJob.ExecuteTask(TaskId,RestartTask); + SetRes(nil); + Except + on e : Exception do + if e.InheritsFrom(EWaiting) then + MyQueue.DoWaiting(e,TaskId) + else + SetRes(e); + end; + end; + until SomeJob=false; +end; + +constructor TQueueThread.Create(aQueue: TJobQueue); +begin + MyQueue := aQueue; + inherited Create(False); +end; + +procedure TQueueThread.Execute; +var wRes : TWaitResult; +begin + while not Terminated do + begin + wRes:=MyQueue.FEvent.WaitFor(WAIT_TIME); + if not(Terminated) then + Begin + if not(ProcessJob) then + if wRes=wrTimeout then + if Assigned(MyQueue.OnIdle) then + MyQueue.OnIdle(self); + end; + end; + MyQueue.EnterCriticalSection; + Try + inc(MyQueue.TerminatedThread); + if Assigned(MyQueue.TerminateEvent) then + if MyQueue.TerminatedThread=MyQueue.Threads.count then + MyQueue.TerminateEvent.SetEvent; + finally + MyQueue.LeaveCriticalSection; + end; +end; + +{ TjobQueue } + +procedure TjobQueue.SetUseThreads(AValue: boolean); +begin + if FUseThreads=AValue then + Exit; + FUseThreads:=AValue; + if Fusethreads then + InitThreads + else + FreeThreads; +end; + +procedure TjobQueue.ClearWaitings; +var i : integer; +begin + For i:=0 to pred(Waitings.count) do + Waitings.Objects[i].Free; + Waitings.Clear; +end; + +procedure TjobQueue.InitThreads; +var i : integer; +begin + Jobs:=TObjectList.Create(true); + Threads:=TObjectList.Create(true); + FEvent:=TEvent.Create(nil,true,false,''); + FSect:=TCriticalSection.Create; + TerminatedThread := 0; + For i:=1 to FNbThread do + Threads.Add(TQueueThread.Create(self)); +end; + +procedure TjobQueue.FreeThreads; +var i : integer; +begin + if Assigned(Threads) then + Begin + TerminateEvent := TEvent.Create(nil,false,false,''); + Try + FEvent.SetEvent; + TerminatedThread:=0; + For i:=0 to pred(Threads.Count) do + TQueueThread(Threads[i]).Terminate; + TerminateEvent.WaitFor(TERMINATE_TIMEOUT); + FreeAndNil(FSect); + FreeAndNil(FEvent); + FreeAndNil(Threads); + finally + FreeAndNil(TerminateEvent); + end; + FreeAndNil(Jobs); + end; +end; + +procedure TjobQueue.EnterCriticalSection; +begin + if Assigned(FSect) and UseThreads then + FSect.Enter; +end; + +procedure TjobQueue.LeaveCriticalSection; +begin + if Assigned(FSect) and UseThreads then + FSect.Leave; +end; + +procedure TjobQueue.DoWaiting(E : Exception;TaskId : integer); +var we : EWaiting; +begin + EnterCriticalSection; + try + we:=EWaiting(e); + pAddWaiting(we.FLauncher,TaskId,we.FNewJob.Name); + AddUniqueJob(we.FNewJob,we.FLauncher.FLauncher); + finally + LeaveCriticalSection; + end; +end; + +procedure TjobQueue.pAddWaiting(aJob: TJob; aTask: integer; JobId: String); +begin + Waitings.AddObject(JobId,TRestartTask.Create(aJob,aTask)); +end; + +procedure TjobQueue.pTaskStarted(aJob: TJob; aTask: integer); +begin + aJob.pTaskStarted(aTask); +end; + +procedure TjobQueue.pJobCompleted(var aJob: TJob); +Begin + pNotifyWaitings(aJob); + if FuseThreads then + Begin + Jobs.Remove(aJob); + aJob:=nil; + end + else + FreeAndNil(aJob); +end; + +procedure TjobQueue.pTaskEnded(var aJob: TJob; aTask: integer; aExcept: Exception); +begin + aJob.pTaskEnded(aTask,aExcept); + if (aJob.pGetTask=ALL_TASK_COMPLETED) then + Begin + pJobcompleted(aJob); + end; +end; + +function TjobQueue.pGetJob(out TaskId : integer;out Restart : boolean): TJob; +var iJob : integer; + aJob : TJob; +begin + Restart:=false; + Result:=nil; + For iJob:=0 to pred(Jobs.Count) do + Begin + aJob:=TJob(Jobs[iJob]); + if aJob.InheritsFrom(TRestartTask) then + Begin + result:=TRestartTask(aJob).FJob; + TaskId:=TRestartTask(aJob).FTask; + Restart:=true; + Jobs.Delete(iJob); + Exit; + end; + TaskId:=aJob.pGetTask; + if (TaskId>NO_MORE_TASK) or (TaskId=ALL_TASK_COMPLETED) then + Begin + Result:=aJob; + Exit; + end; + end; + if not(assigned(result)) then + TaskId:=NO_MORE_TASK; +end; + +function TjobQueue.pFindJobByName(const aName: string;ByLauncher: TObject): TJobArray; +var iRes,i : integer; +begin + SetLength(result,Jobs.count); + iRes:=0; + For i:=0 to pred(Jobs.Count) do + Begin + if TJob(Jobs[i]).Name=aName then + begin + if (ByLauncher=nil) or (TJob(Jobs[i]).FLauncher=ByLauncher) then + Begin + Result[iRes]:=TJob(Jobs[i]); + inc(iRes); + end; + end; + end; + SetLength(result,iRes); +end; + +procedure TjobQueue.pNotifyWaitings(aJob: TJob); +var JobId : String; + ObjRestart : TRestartTask; + idx : integer; +begin + JobId:=aJob.Name; + Repeat + idx:=waitings.IndexOf(JobId); + if idx<>-1 then + Begin + ObjRestart:=TRestartTask(waitings.Objects[idx]); + waitings.Delete(idx); + Jobs.Add(ObjRestart); + end; + until idx=-1; +end; + +function TjobQueue.IsMainThread: boolean; +begin + Result:=GetCurrentThreadId=FMainThreadID; +end; + +constructor TjobQueue.Create(NbThread: integer); +begin + waitings:=TStringList.create; + FNbThread:=NbThread; + FMainThreadId:=GetCurrentThreadId; +end; + +destructor TjobQueue.Destroy; +begin + FreeThreads; + ClearWaitings; + FreeAndNil(Waitings); + inherited; +end; + +procedure TjobQueue.QueueAsyncCall(const AMethod: TDataEvent; Data: PtrInt); +begin + if UseThreads then + Application.QueueAsyncCall(aMethod,Data) + else + AMethod(Data); +end; + + +Type + +{ TSyncCallData } + + TSyncCallData = Class + private + FMethod : TDataEvent; + FData : PtrInt; + public + Constructor Create(AMethod : TDataEvent;AData : PtrInt); + Procedure SyncCall; + End; + +{ TSyncCallData } + +constructor TSyncCallData.Create(AMethod: TDataEvent; AData: PtrInt); +begin + FMethod:=AMethod; + FData:=AData; + +end; + +procedure TSyncCallData.SyncCall; +begin + FMethod(FData); +end; + +procedure TjobQueue.QueueSyncCall(const AMethod: TDataEvent; Data: PtrInt); +var tmp : TSyncCallData; +begin + tmp := TSyncCallData.Create(AMethod,Data); + Try + TThread.Synchronize(nil,@tmp.SyncCall); + finally + tmp.free; + end; +end; + +procedure TjobQueue.AddJob(aJob: TJob;Launcher : TObject); +var TaskId : Integer; + restart : boolean; +begin + aJob.FLauncher:=Launcher; + aJob.Queue:=self; + if Usethreads then + Begin + EnterCriticalSection; + Try + Jobs.add(aJob); + finally + LeaveCriticalSection; + end; + FEvent.SetEvent; + end + Else + Begin + Try + Repeat + TaskId:=aJob.pGetTask; + restart:=false; + if TaskId>NO_MORE_TASK then + Begin + pTaskStarted(aJob,TaskId); + Try + aJob.ExecuteTask(TaskId,restart); + pTaskEnded(aJob,TaskId,nil); + except + on e : Exception do + Begin + if not(e.InheritsFrom(EWaiting)) then + pTaskEnded(aJob,TaskId,e) + else + DoWaiting(e,TaskId); + end; + end; + end; + if not(Assigned(aJob)) then + TaskId:=ALL_TASK_COMPLETED; + until TaskId=ALL_TASK_COMPLETED; + finally + aJob.Free; + end; + end; +end; + +function TjobQueue.AddUniqueJob(aJob: TJob; Launcher: TObject): boolean; +var lst : TJobArray; +begin + Result:=true; + if FUseThreads then + Begin + aJob.Queue:=self; + aJob.FLauncher:=Launcher; + EnterCriticalSection; + Try + lst:=pFindJobByName(aJob.Name,Launcher); + if length(lst)=0 then + Jobs.add(aJob) + else + Result:=false; + finally + LeaveCriticalSection; + end; + FEvent.SetEvent;; + end + Else + AddJob(aJob,Launcher); +end; + +function TjobQueue.CancelAllJob(ByLauncher: TObject) : TJobArray; +var i,iJob : integer; +begin + SetLength(Result,0); + if FUseThreads then + Begin + EnterCriticalSection; + Try + SetLEngth(Result,Jobs.Count); + iJob:=0; + For i:=pred(Jobs.Count) downto 0 do + Begin + if (ByLauncher=nil) or (TJob(Jobs[i]).FLauncher=ByLauncher) then + Begin + TJob(Jobs[i]).Cancel; + Result[iJob]:=TJob(Jobs[i]); + iJob+=1; + End; + End; + SetLength(Result,iJob); + finally + LeaveCriticalSection; + end; + end; +end; + +function TjobQueue.CancelJobByName(aJobName: String;ByLauncher: TObject) : boolean; +var lst : TJobArray; + i : integer; +begin + Result:=false; + if FUseThreads then + Begin + EnterCriticalSection; + Try + lst:=pFindJobByName(aJobName,ByLauncher); + For i:=low(lst) to high(lst) do + Begin + result:=true; + lst[i].Cancel; + End; + finally + LeaveCriticalSection; + end; + end; +end; + +procedure TjobQueue.WaitForTerminate(const lstJob: TJobArray); +var OneFound : Boolean; + i : integer; + mThread : Boolean; + TimeOut : integer; +begin + TimeOut:=0; + mThread:=IsMainThread; + if FUseThreads then + Begin + repeat + OneFound:=False; + EnterCriticalSection; + Try + For i:=low(lstJob) to high(lstJob) do + Begin + if Jobs.IndexOf(lstJob[i])<>-1 then + Begin + OneFound:=True; + break; + end; + end; + finally + LeaveCriticalSection; + end; + if OneFound and (TimeOut>200) then + Raise Exception.Create('TimeOut'); + if mThread then + Application.ProcessMessages; + if OneFound then + Sleep(100); + Inc(TimeOut); + until not(OneFound); + end; +end; + +procedure TjobQueue.WaitAllJobTerminated(ByLauncher: TObject); +var OneFound : boolean; + i : integer; + TimeOut : integer; + mThread : Boolean; + + Procedure CheckTimeOut; + Begin + if TimeOut>200 then + Raise Exception.Create('TimeOut'); + if mThread then + Application.ProcessMessages; + sleep(100); + inc(TimeOut); + end; + +begin + TimeOut:=0; + if FUseThreads then + Begin + mThread:=IsMainThread; + if ByLauncher=nil then + Begin + While Jobs.Count>0 do + CheckTimeOut; + end + else + Begin + repeat + OneFound:=False; + EnterCriticalSection; + Try + For i:=0 to pred(Jobs.Count) do + Begin + if TJob(Jobs[i]).FLauncher=ByLauncher then + Begin + OneFound:=True; + break; + end; + end; + finally + LeaveCriticalSection; + end; + if OneFound then + CheckTimeOut; + until not(OneFound); + end; + end; +end; + +{ TjobQueue } + +procedure TJob.Cancel; +var lst : Array of TRestartTask; + i,idx : integer; +begin + Queue.EnterCriticalSection; + Try + FCancelled := true; + if (Name<>'') and (Queue.waitings.count>0) then + Begin + SetLength(lst,0); + Repeat + idx:=Queue.waitings.IndexOf(Name); + if idx<>-1 then + Begin + SetLength(lst,length(lst)+1); + lst[high(lst)]:=TRestartTask(Queue.waitings.Objects[idx]); + Queue.waitings.Delete(idx); + end; + until idx=-1; + For i:=low(lst) to high(lst) do + Begin + lst[i].Cancel; + lst[i].pTaskEnded(1,nil); + lst[i].Free; + end; + end; + DoCancel; + finally + Queue.LeaveCriticalSection; + end; +end; + +procedure TJob.DoCancel; +begin + +end; + +function TJob.pGetTask: integer; +begin + result:=ALL_TASK_COMPLETED; +end; + +procedure TJob.WaitForResultOf(aJob: TJob); +begin + Raise EWaiting.Create(self,aJob); +end; + +procedure TJob.EnterCriticalSection; +begin + Queue.EnterCriticalSection; +end; + +procedure TJob.LeaveCriticalSection; +begin + Queue.LeaveCriticalSection; +end; + +end. + diff --git a/components/lazmapviewer/source/mvjobs.pas b/components/lazmapviewer/source/mvjobs.pas new file mode 100644 index 000000000..6de08514e --- /dev/null +++ b/components/lazmapviewer/source/mvjobs.pas @@ -0,0 +1,130 @@ +{ + basics jobs for multi-threading(c) 2014 ti_dic + + 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. +} +unit mvJobs; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils,mvJobQueue; + + +type + { TSimpleJob } + //job with only one task + TSimpleJob = class(TJob) + private + FRunning,FEnded : boolean; + protected + function pGetTask : integer;override; + procedure pTaskStarted(aTask: integer);override; + procedure pTaskEnded(aTask : integer;aExcept : Exception);override; + public + function Running : boolean;override; + end; + + TJobProc = Procedure (Data : TObject;Job : TJob) of object; + + { TEventJob } + //job with only one task (callback an event) + TEventJob = Class(TSimpleJob) + private + FData : TObject; + FTask : TJobProc; + FOwnData : Boolean; + public + constructor Create(aEvent : TJobProc;Data : TObject;OwnData : Boolean;JobName : String='');virtual; + procedure ExecuteTask(aTask : integer;FromWaiting : boolean);override; + destructor Destroy;override; + end; + + +implementation + +{ TEventJob } + +constructor TEventJob.Create(aEvent: TJobProc; Data: TObject; + OwnData: Boolean;JobName : String=''); +begin + Name:=JobName; + FTask:=aEvent; + if Assigned(Data) or OwnData then + Begin + FData:=Data; + FOwnData:=OwnData; + end + else + Begin + FOwnData:=false; + FData:=self; + end; +end; + +procedure TEventJob.ExecuteTask(aTask : integer;FromWaiting : boolean); +begin + if Assigned(FTask) then + FTask(FData,self); +end; + +destructor TEventJob.Destroy; +begin + if FOwnData then + if FData<>self then + FData.Free; + inherited Destroy; +end; + +{ TSimpleJob } + +function TSimpleJob.pGetTask: integer; +begin + if FRunning or Cancelled then + Begin + if not FRunning then + Result := ALL_TASK_COMPLETED + else + Result:=NO_MORE_TASK + end + else + if FEnded then + Result := ALL_TASK_COMPLETED + else + Result:=1; +end; + +procedure TSimpleJob.pTaskStarted(aTask: integer); +begin + FEnded:=false; + FRunning:=True; +end; + +procedure TSimpleJob.pTaskEnded(aTask: integer; aExcept: Exception); +begin + FEnded:=True; + FRunning:=False; +end; + +function TSimpleJob.Running: boolean; +begin + Result:=FRunning; +end; + + +end. + diff --git a/components/lazmapviewer/source/mvmapprovider.pas b/components/lazmapviewer/source/mvmapprovider.pas new file mode 100644 index 000000000..9c9657469 --- /dev/null +++ b/components/lazmapviewer/source/mvmapprovider.pas @@ -0,0 +1,172 @@ +{ + (c) 2014 ti_dic + + 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. +} +unit mvMapProvider; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; +Type + { TTileId } + TTileId = record + X,Y : int64; + Z : integer; + end; + + + TGetSvrStr = Function (id : integer) : string of object; + TGetValStr = Function (const Tile : TTileId) : String of object; + + { TMapProvider } + + TMapProvider = Class + private + FLayer : integer; + idServer : Array of Integer; + FName : String; + FUrl : Array of string; + FNbSvr : Array of integer; + FGetSvrStr : Array of TGetSvrStr; + FGetXStr : Array of TGetValStr; + FGetYStr : Array of TGetValStr; + FGetZStr : Array of TGetValStr; + FMinZoom : Array of integer; + FMaxZoom : Array of integer; + function getLayerCount: integer; + procedure SetLayer(AValue: integer); + + public + constructor Create(aName : String); + destructor Destroy; override; + procedure AddURL(Url: String; NbSvr: integer;aMinZoom : integer;aMaxZoom : integer; GetSvrStr: TGetSvrStr; GetXStr: TGetValStr; GetYStr: TGetValStr; GetZStr: TGetValStr); + procedure GetZoomInfos(out zMin:integer;out zMax : integer); + Function GetUrlForTile(id : TTileId) : String; + property Name : String read FName; + property LayerCount : integer read getLayerCount; + property Layer : integer read FLayer write SetLayer; + end; + + +implementation + +{ TMapProvider } + +function TMapProvider.getLayerCount: integer; +begin + Result:=length(FUrl); +end; + +procedure TMapProvider.SetLayer(AValue: integer); +begin + if FLayer=AValue then Exit; + if (aValue<low(FUrl)) and (aValue>high(FUrl)) then + Begin + Raise Exception.create('bad Layer'); + end; + FLayer:=AValue; +end; + +constructor TMapProvider.Create(aName: String); +begin + FName:=aName; +end; + +destructor TMapProvider.Destroy; +begin + Finalize(idServer); + Finalize(FName); + Finalize(FUrl); + Finalize(FNbSvr); + Finalize(FGetSvrStr); + Finalize(FGetXStr); + Finalize(FGetYStr); + Finalize(FGetZStr); + Finalize(FMinZoom); + Finalize(FMaxZoom); + inherited; +end; + +procedure TMapProvider.AddURL(Url: String; NbSvr: integer; + aMinZoom : integer;aMaxZoom : integer; + GetSvrStr: TGetSvrStr; GetXStr: TGetValStr; GetYStr: TGetValStr; + GetZStr: TGetValStr); +var nb : integer; +begin + nb:=length(FUrl)+1; + SetLength(IdServer,nb); + SetLength(FUrl,nb); + SetLength(FNbSvr,nb); + SetLength(FGetSvrStr,nb); + SetLength(FGetXStr,nb); + SetLength(FGetYStr,nb); + SetLength(FGetZStr,nb); + SetLength(FMinZoom,nb); + SetLength(FMaxZoom,nb); + nb:=high(FUrl); + FUrl[nb]:=Url; + FNbSvr[nb]:=NbSvr; + FMinZoom[nb]:=aMinZoom; + FMaxZoom[nb]:=aMaxZoom; + FGetSvrStr[nb]:=GetSvrStr; + FGetXStr[nb]:=GetXStr; + FGetYStr[nb]:=GetYStr; + FGetZStr[nb]:=GetZStr; + FLayer:=low(FUrl); +end; + +procedure TMapProvider.GetZoomInfos(out zMin: integer; out zMax: integer); +begin + zMin:=FMinZoom[layer]; + zMax:=FMaxZoom[layer]; +end; + +function TMapProvider.GetUrlForTile(id: TTileId): String; +var i : integer; + XVal,yVal,zVal,SvrVal : String; + idsvr: integer; +begin + Result:=''; + i:=layer; + if (i>high(idServer)) or (i<low(idServer)) or (FNbSvr[i]=0) then + exit; + + idsvr:=idServer[i] mod FNbSvr[i]; + idServer[i]+=1; + + SvrVal:=inttostr(idsvr); + XVal:=inttostr(id.X); + YVal:=inttostr(id.Y); + ZVal:=inttostr(id.Z); + if Assigned(FGetSvrStr[i]) then + SvrVal:=FGetSvrStr[i](idsvr); + if Assigned(FGetXStr[i]) then + XVal:=FGetXStr[i](id); + if Assigned(FGetYStr[i]) then + YVal:=FGetYStr[i](id); + if Assigned(FGetZStr[i]) then + ZVal:=FGetZStr[i](id); + Result:=StringReplace(FUrl[i],'%serv%',SvrVal,[rfreplaceall]); + Result:=StringReplace(Result,'%x%',XVal,[rfreplaceall]); + Result:=StringReplace(Result,'%y%',YVal,[rfreplaceall]); + Result:=StringReplace(Result,'%z%',ZVal,[rfreplaceall]); +end; + +end. + diff --git a/components/lazmapviewer/source/mvmapviewer.pas b/components/lazmapviewer/source/mvmapviewer.pas new file mode 100644 index 000000000..057434449 --- /dev/null +++ b/components/lazmapviewer/source/mvmapviewer.pas @@ -0,0 +1,834 @@ +{ (c) 2014 ti_dic MapViewer component for lazarus + Parts of this component are based on : + Map Viewer 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. +} + +unit mvmapviewer; + +{$MODE objfpc}{$H+} + +// Activate one of the following defines +{$DEFINE USE_LAZINTFIMAGE} +{.$DEFINE USE_RGBGRAPHICS} // NOTE: This needs package "rgb_graphics" in requirements + +// Make sure that one of the USE_XXXX defines is active. Default is USE_LAZINTFIMAGE +{$IFNDEF USE_RGBGRAPHICS}{$IFNDEF USE_LAZINTFIMAGE}{$DEFINE USE_LAZINTFIMAGES}{$ENDIF}{$ENDIF} +{$IFDEF USE_RGBGRAPHICS}{$IFDEF USE_LAZINTFIMAGE}{$UNDEF USE_RGBGRAPHICS}{$ENDIF}{$ENDIF} + +interface + +uses + Classes, SysUtils, Controls, Graphics, IntfGraphics, + {$IFDEF USE_RGBGRAPHICS}RGBGraphics,{$ENDIF} + {$IFDEF USE_LAZINTFIMAGE}FPCanvas,{$ENDIF} + MvTypes, MvGPSObj, MvEngine, MvMapProvider, MVDLESynapse; + +Type + + { TMapView } + + TMapView = class(TCustomControl) + private + dl : TMVDESynapse; + FEngine : TMapViewerEngine; + {$IFDEF USE_RGBGRAPHICS} + Buffer : TRGB32Bitmap; + {$ENDIF} + {$IFDEF USE_LAZINTFIMAGE} + Buffer: TLazIntfImage; + BufferCanvas: TFPCustomCanvas; + {$ENDIF} + FActive: boolean; + FGPSItems: TGPSObjectList; + FInactiveColor: TColor; + FPOIImage: TBitmap; + procedure CallAsyncInvalidate; + procedure DoAsyncInvalidate(Data: PtrInt); + procedure DrawObjects(const TileId: TTileId; aLeft, aTop, aRight,aBottom: integer); + procedure DrawPt(const Area: TRealArea;aPOI: TGPSPoint); + procedure DrawTrk(const Area: TRealArea;trk: TGPSTrack); + function GetCacheOnDisk: boolean; + function GetCachePath: String; + function GetCenter: TRealPoint; + function GetMapProvider: String; + function GetOnCenterMove: TNotifyEvent; + function GetOnChange: TNotifyEvent; + function GetOnZoomChange: TNotifyEvent; + function GetUseThreads: boolean; + function GetZoom: integer; + procedure SetActive(AValue: boolean); + procedure SetCacheOnDisk(AValue: boolean); + procedure SetCachePath(AValue: String); + procedure SetCenter(AValue: TRealPoint); + procedure SetInactiveColor(AValue: TColor); + procedure SetMapProvider(AValue: String); + procedure SetOnCenterMove(AValue: TNotifyEvent); + procedure SetOnChange(AValue: TNotifyEvent); + procedure SetOnZoomChange(AValue: TNotifyEvent); + procedure SetUseThreads(AValue: boolean); + procedure SetZoom(AValue: integer); + + protected + AsyncInvalidate : boolean; + procedure ActivateEngine; + {$IFDEF USE_LAZINTFIMAGE} + procedure CreateLazIntfImageAndCanvas(out ABuffer: TLazIntfImage; + out ACanvas: TFPCustomCanvas; AWidth, AHeight: Integer); + {$ENDIF} + procedure DblClick; override; + Procedure DoDrawTile(const TileId: TTileId; X,Y: integer; TileImg: TLazIntfImage); + function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override; + procedure DoOnResize; override; + Function IsActive : Boolean; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X,Y: Integer); override; + procedure Paint; override; + procedure OnGPSItemsModified(Sender: TObject; objs: TGPSObjList;Adding : boolean); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure ClearBuffer; + procedure GetMapProviders(lstProviders : TStrings); + function GetVisibleArea: TRealArea; + function LonLatToScreen(aPt: TRealPoint): TPoint; + function ScreenToLonLat(aPt: TPoint): TRealPoint; + procedure CenterOnObj(obj: TGPSObj); + procedure ZoomOnArea(const aArea: TRealArea); + procedure ZoomOnObj(obj: TGPSObj); + procedure WaitEndOfRendering; + property Center: TRealPoint read GetCenter write SetCenter; + property Engine: TMapViewerEngine read FEngine; + property GPSItems: TGPSObjectList read FGPSItems; + published + property Active: boolean read FActive write SetActive; + property Align; + property CacheOnDisk: boolean read GetCacheOnDisk write SetCacheOnDisk; + property CachePath: String read GetCachePath write SetCachePath; + property Height default 150; + property InactiveColor: TColor read FInactiveColor write SetInactiveColor; + property MapProvider: String read GetMapProvider write SetMapProvider; + property POIImage: TBitmap read FPOIImage write FPOIImage; + property PopupMenu; + property UseThreads: boolean read GetUseThreads write SetUseThreads; + property Width default 150; + property Zoom: integer read GetZoom write SetZoom; + property OnCenterMove: TNotifyEvent read GetOnCenterMove write SetOnCenterMove; + property OnZoomChange: TNotifyEvent read GetOnZoomChange write SetOnZoomChange; + property OnChange: TNotifyEvent Read GetOnChange write SetOnChange; + property OnMouseDown; + property OnMouseEnter; + property OnMouseLeave; + property OnMouseMove; + property OnMouseUp; + end; + + procedure Register; + +implementation +uses + {$IFDEF USE_LAZINTFIMAGE} + Math, FPImgCanv, FPImage, LCLVersion, + {$ENDIF} + GraphType, mvjobqueue, mvextradata, LResources; + +procedure Register; +begin + {$I mvmapviewer_icon.lrs} + RegisterComponents('Maps',[TMapView]); +end; + +{$IFDEF USE_LAZINTFIMAGE} +// Workaround for http://mantis.freepascal.org/view.php?id=27144 +procedure CopyPixels(ASource, ADest: TLazIntfImage; + XDst: Integer = 0; YDst: Integer = 0; + AlphaMask: Boolean = False; AlphaTreshold: Word = 0); +var + SrcHasMask, DstHasMask: Boolean; + x, y, xStart, yStart, xStop, yStop: Integer; + c: TFPColor; + SrcRawImage, DestRawImage: TRawImage; +begin + ASource.GetRawImage(SrcRawImage); + ADest.GetRawImage(DestRawImage); + + if DestRawImage.Description.IsEqual(SrcRawImage.Description) and (XDst = 0) and (YDst = 0) then + begin + // same description -> copy + if DestRawImage.Data <> nil then + System.Move(SrcRawImage.Data^, DestRawImage.Data^, DestRawImage.DataSize); + if DestRawImage.Mask <> nil then + System.Move(SrcRawImage.Mask^, DestRawImage.Mask^, DestRawImage.MaskSize); + Exit; + end; + + // copy pixels + XStart := IfThen(XDst < 0, -XDst, 0); + YStart := IfThen(YDst < 0, -YDst, 0); + XStop := IfThen(ADest.Width - XDst < ASource.Width, ADest.Width - XDst, ASource.Width) - 1; + YStop := IfTHen(ADest.Height - YDst < ASource.Height, ADest.Height - YDst, ASource.Height) - 1; + + SrcHasMask := SrcRawImage.Description.MaskBitsPerPixel > 0; + DstHasMask := DestRawImage.Description.MaskBitsPerPixel > 0; + + if DstHasMask then begin + for y:= yStart to yStop do + for x:=xStart to xStop do + ADest.Masked[x+XDst,y+YDst] := SrcHasMask and ASource.Masked[x,y]; + end; + + for y:=yStart to yStop do + for x:=xStart to xStop do + begin + c := ASource.Colors[x,y]; + if not DstHasMask and SrcHasMask and (c.alpha = $FFFF) then // copy mask to alpha channel + if ASource.Masked[x,y] then + c.alpha := 0; + + ADest.Colors[x+XDst,y+YDst] := c; + if AlphaMask and (c.alpha < AlphaTreshold) then + ADest.Masked[x+XDst,y+YDst] := True; + end; +end; +{$ENDIF} + +Type + + { TDrawObjJob } + + TDrawObjJob = Class(TJob) + private + AllRun : boolean; + Viewer : TMapView; + FRunning : boolean; + FLst : TGPSObjList; + FStates : Array of integer; + FArea : TRealArea; + protected + function pGetTask : integer;override; + procedure pTaskStarted(aTask: integer);override; + procedure pTaskEnded(aTask : integer;aExcept : Exception);override; + public + procedure ExecuteTask(aTask : integer;FromWaiting : boolean);override; + function Running : boolean;override; + public + Constructor Create(aViewer : TMapView;aLst : TGPSObjList;const aArea : TRealArea); + destructor Destroy;override; + end; + +{ TDrawObjJob } + +function TDrawObjJob.pGetTask: integer; +var i : integer; +begin + if not(AllRun) and not(Cancelled) then + Begin + For i:=low(FStates) to high(FStates) do + if FStates[i]=0 then + Begin + result:=i+1; + Exit; + end; + AllRun:=True; + end; + Result:=ALL_TASK_COMPLETED; + For i:=low(FStates) to high(FStates) do + if FStates[i]=1 then + Begin + Result:=NO_MORE_TASK; + Exit; + end; +end; + +procedure TDrawObjJob.pTaskStarted(aTask: integer); +begin + FRunning:=True; + FStates[aTask-1]:=1; +end; + +procedure TDrawObjJob.pTaskEnded(aTask: integer; aExcept: Exception); +begin + if Assigned(aExcept) then + FStates[aTask-1]:=3 + Else + FStates[aTask-1]:=2; +end; + +procedure TDrawObjJob.ExecuteTask(aTask: integer; FromWaiting: boolean); +var iObj : integer; + Obj : TGpsObj; +begin + iObj:=aTask-1; + Obj:=FLst[iObj]; + if Obj.InheritsFrom(TGPSTrack) then + Begin + Viewer.DrawTrk(FArea,TGPSTrack(Obj)); + End; + if Obj.InheritsFrom(TGPSPoint) then + Begin + Viewer.DrawPt(FArea,TGPSPoint(Obj)); + end; +end; + +function TDrawObjJob.Running: boolean; +begin + Result:=FRunning; +end; + +constructor TDrawObjJob.Create(aViewer: TMapView; aLst: TGPSObjList; + const aArea: TRealArea); +begin + FArea:=aArea; + FLst:=aLst; + SetLEngth(FStates,FLst.Count); + Viewer:=aViewer; + AllRun:=false; + Name:='DrawObj'; +end; + +destructor TDrawObjJob.Destroy; +begin + inherited Destroy; + FreeAndNil(FLst); + if not(Cancelled) then + Viewer.CallAsyncInvalidate; +end; + + +{ TMapView } + +procedure TMapView.SetActive(AValue: boolean); +begin + if FActive=AValue then Exit; + FActive:=AValue; + if FActive then + ActivateEngine + else + Engine.Active:=false; +end; + +function TMapView.GetCacheOnDisk: boolean; +begin + Result:=Engine.CacheOnDisk; +end; + +function TMapView.GetCachePath: String; +begin + Result:=Engine.CachePath; +end; + +function TMapView.GetCenter: TRealPoint; +begin + Result:=Engine.Center; +end; + +function TMapView.GetMapProvider: String; +begin + result:=Engine.MapProvider; +end; + +function TMapView.GetOnCenterMove: TNotifyEvent; +begin + result:=Engine.OnCenterMove; +end; + +function TMapView.GetOnChange: TNotifyEvent; +begin + Result:=Engine.OnChange; +end; + +function TMapView.GetOnZoomChange: TNotifyEvent; +begin + Result:=Engine.OnZoomChange; +end; + +function TMapView.GetUseThreads: boolean; +begin + Result:=Engine.UseThreads; +end; + +function TMapView.GetZoom: integer; +begin + result:=Engine.Zoom; +end; + +procedure TMapView.SetCacheOnDisk(AValue: boolean); +begin + Engine.CacheOnDisk:=AValue; +end; + +procedure TMapView.SetCachePath(AValue: String); +begin + Engine.CachePath:=CachePath; +end; + +procedure TMapView.SetCenter(AValue: TRealPoint); +begin + Engine.Center:=AValue; +end; + +procedure TMapView.SetInactiveColor(AValue: TColor); +begin + 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; +end; + +procedure TMapView.SetMapProvider(AValue: String); +begin + Engine.MapProvider:=AValue; +end; + +procedure TMapView.SetOnCenterMove(AValue: TNotifyEvent); +begin + Engine.OnCenterMove:=AValue; +end; + +procedure TMapView.SetOnChange(AValue: TNotifyEvent); +begin + Engine.OnChange:=AValue; +end; + +procedure TMapView.SetOnZoomChange(AValue: TNotifyEvent); +begin + Engine.OnZoomChange:=AValue; +end; + +procedure TMapView.SetUseThreads(AValue: boolean); +begin + Engine.UseThreads:=aValue; +end; + +procedure TMapView.SetZoom(AValue: integer); +begin + Engine.Zoom:=AValue; +end; + +function TMapView.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; + MousePos: TPoint): Boolean; +begin + Result:=inherited DoMouseWheel(Shift, WheelDelta, MousePos); + if IsActive then + Engine.MouseWheel(self,Shift,WheelDelta,MousePos,Result); +end; + +procedure TMapView.MouseDown(Button: TMouseButton; Shift: TShiftState; X, + Y: Integer); +begin + inherited MouseDown(Button, Shift, X, Y); + if IsActive then + Engine.MouseDown(self,Button,Shift,X,Y); +end; + +procedure TMapView.MouseUp(Button: TMouseButton; Shift: TShiftState; + X: Integer; 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; +begin + inherited MouseMove(Shift, X, Y); + if IsActive then + Engine.MouseMove(self,Shift,X,Y); +end; + +procedure TMapView.DblClick; +begin + inherited DblClick; + if IsActive then + Engine.DblClick(self); +end; + +procedure TMapView.DoOnResize; +begin + inherited DoOnResize; + //cancel all rendering threads + Engine.CancelCurrentDrawing; + FreeAndNil(Buffer); + {$IFDEF USE_RGBGRAPHICS} + Buffer := TRGB32Bitmap.Create(ClientWidth,ClientHeight); + {$ENDIF} + {$IFDEF USE_LAZINTFIMAGE} + BufferCanvas.Free; + CreateLazIntfImageAndCanvas(Buffer, BufferCanvas, ClientWidth, ClientHeight); + {$ENDIF} + if IsActive then + Engine.SetSize(ClientWidth, ClientHeight); +end; + +procedure TMapView.Paint; +var + bmp: TBitmap; +begin + inherited Paint; + if IsActive and Assigned(Buffer) then + begin + {$IFDEF USE_RGBGRAPHICS} + Buffer.Canvas.DrawTo(Canvas,0,0); + {$ENDIF} + {$IFDEF USE_LAZINTFIMAGE} + bmp := TBitmap.Create; + try + bmp.SetSize(Buffer.Width, Buffer.Height); + bmp.LoadFromIntfImage(Buffer); + Canvas.Draw(0, 0, bmp); + finally + bmp.Free; + end; + {$ENDIF} + end + else + begin + Canvas.Brush.Color:=InactiveColor; + Canvas.Brush.Style:=bsSolid; + Canvas.FillRect(0,0,ClientWidth,ClientHeight); + end; +end; + +procedure TMapView.OnGPSItemsModified(Sender: TObject; objs: TGPSObjList; + Adding: boolean); +var Area,ObjArea,vArea : TRealArea; +begin + if Adding and assigned(Objs) then + Begin + ObjArea:=GetAreaOf(Objs); + vArea:=GetVisibleArea; + if hasIntersectArea(ObjArea,vArea) then + Begin + Area:=IntersectArea(ObjArea,vArea); + Engine.Jobqueue.AddJob(TDrawObjJob.Create(self,Objs,Area),Engine); + end + else + objs.Free; + end + else + Begin + Engine.Redraw; + Objs.free; + end; +end; + +procedure TMapView.DrawTrk(const Area : TRealArea;trk : TGPSTrack); +var Old,New : TPoint; + i : integer; + aPt : TRealPoint; + LastInside,IsInside : boolean; + trkColor : TColor; +Begin + if trk.Points.Count>0 then + Begin + trkColor:=clRed; + if trk.ExtraData<>nil then + Begin + if trk.ExtraData.inheritsFrom(TDrawingExtraData) then + trkColor:=TDrawingExtraData(trk.ExtraData).Color; + end; + LastInside:=false; + For i:=0 to pred(trk.Points.Count) do + Begin + aPt:=trk.Points[i].RealPoint; + IsInside:=PtInsideArea(aPt,Area); + if IsInside or LastInside then + Begin + New:=Engine.LonLatToScreen(aPt); + if i>0 then + 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); + {$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; + end; + end; + end; +end; + +procedure TMapView.DrawPt(const Area: TRealArea; aPOI: TGPSPoint); +var + PT : TPoint; + PtColor : TColor; +begin + Pt:=Engine.LonLatToScreen(aPOI.RealPoint); + PtColor:=clRed; + if aPOI.ExtraData<>nil then + Begin + if aPOI.ExtraData.inheritsFrom(TDrawingExtraData) then + PtColor:=TDrawingExtraData(aPOI.ExtraData).Color; + end; + {$IFDEF USE_RGBGRAPHICS} + Buffer.canvas.OutlineColor:=ptColor; + Buffer.canvas.Line(Pt.X,Pt.y-5,Pt.X,Pt.Y+5); + Buffer.canvas.Line(Pt.X-5,Pt.y,Pt.X+5,Pt.Y); + {$ENDIF} + {$IFDEF USE_LAZINTFIMAGE} + BufferCanvas.Pen.FPColor := TColorToFPColor(ptColor); + BufferCanvas.Line(Pt.X, Pt.Y-5, Pt.X, Pt.Y+5); + BufferCanvas.Line(Pt.X-5, Pt.Y, Pt.X+5, Pt.Y); + {$ENDIF} + +// Buffer.Draw(); +end; + +procedure TMapView.CallAsyncInvalidate; +Begin + if not(AsyncInvalidate) then + Begin + AsyncInvalidate:=true; + Engine.Jobqueue.QueueAsyncCall(@DoAsyncInvalidate,0); + end; +end; + +procedure TMapView.DrawObjects(const TileId: TTileId; aLeft, aTop,aRight,aBottom: integer); +var aPt : TPoint; + Area : TRealArea; + lst : TGPSObjList; + i : integer; + trk : TGPSTrack; +begin + aPt.X:=aLeft; + aPt.Y:=aTop; + Area.TopLeft:=Engine.ScreenToLonLat(aPt); + aPt.X:=aRight; + aPt.Y:=aBottom; + Area.BottomRight:=Engine.ScreenToLonLat(aPt); + if GPSItems.count>0 then + begin + lst:=GPSItems.GetObjectsInArea(Area); + if lst.Count>0 then + Engine.Jobqueue.AddJob(TDrawObjJob.Create(self,lst,Area),Engine) + else + begin + freeAndNil(Lst); + CallAsyncInvalidate; + end; + end + Else + CallAsyncInvalidate; +end; + +procedure TMapView.DoAsyncInvalidate(Data: PtrInt); +Begin + Invalidate; + AsyncInvalidate:=false; +end; + +procedure TMapView.DoDrawTile(const TileId: TTileId; X, Y: integer; + TileImg: TLazIntfImage); +var + {$IFDEF USE_RGBGRAPHICS} + temp : TRGB32Bitmap; + ri : TRawImage; + BuffLaz : TLazIntfImage; + {$ENDIF} + {$IFDEF USE_LAZINTFIMAGE} + temp: TBitmap; + {$ENDIF} +begin + if Assigned(Buffer) then + begin + if Assigned(TileImg) then + Begin + {$IFDEF USE_RGBGRAPHICS} + if (X>=0) and (Y>=0) then //http://mantis.freepascal.org/view.php?id=27144 + begin + ri.Init; + ri.Description.Init_BPP32_R8G8B8A8_BIO_TTB(Buffer.Width,Buffer.Height); + ri.Data:=Buffer.Pixels; + BuffLaz := TLazIntfImage.Create(ri,false); + try + BuffLaz.CopyPixels(TileImg,X,y); + ri.Init; + finally + FreeandNil(BuffLaz); + end; + end + else + begin + //i think it take more memory then the previous method but work in all case + temp:=TRGB32Bitmap.CreateFromLazIntfImage(TileImg); + try + Buffer.Draw(X,Y,temp); + finally + FreeAndNil(Temp); + end; + end; + {$ENDIF} + {$IFDEF USE_LAZINTFIMAGE} + {$IF LCL_FULLVERSION < 1090000} + { Workaround for //http://mantis.freepascal.org/view.php?id=27144 } + CopyPixels(TileImg, Buffer, X, Y); + {$ELSE} + Buffer.CopyPixels(TileImg, X, Y); + {$IFEND} + {$ENDIF} + end + else + {$IFDEF USE_RGBGRAPHICS} + Buffer.Canvas.FillRect(X,Y,X+TILE_SIZE,Y+TILE_SIZE); + {$ENDIF} + {$IFDEF USE_LAZINTFIMAGE} + begin + BufferCanvas.Brush.FPColor := ColWhite; + BufferCanvas.FillRect(X, Y, X + TILE_SIZE, Y + TILE_SIZE); + end; + {$ENDIF} + end; + DrawObjects(TileId,X,Y,X+TILE_SIZE,Y+TILE_SIZE); +end; + +function TMapView.IsActive: Boolean; +begin + if not(csDesigning in ComponentState) then + Result:=FActive + else + Result:=false; +end; + +constructor TMapView.Create(AOwner: TComponent); +begin + Active := false; + FGPSItems := TGPSObjectList.Create; + FGPSItems.OnModified := @OnGPSItemsModified; + FInactiveColor := clWhite; + FEngine := TMapViewerEngine.Create(self); + dl := TMVDESynapse.Create(self); + {$IFDEF USE_RGBGRAPHICS} + Buffer := TRGB32Bitmap.Create(Width,Height); + {$ENDIF} + {$IFDEF USE_LAZINTFIMAGE} + CreateLazIntfImageAndCanvas(Buffer, BufferCanvas, Width, Height); + {$ENDIF} + Engine.CachePath := 'cache/'; + Engine.CacheOnDisk := true; + Engine.OnDrawTile := @DoDrawTile; + Engine.DrawTitleInGuiThread := false; + Engine.DownloadEngine := dl; + inherited Create(AOwner); + Width := 150; + Height := 150; +end; + +destructor TMapView.Destroy; +begin + {$IFDEF USE_LAZINTFIMAGE} + BufferCanvas.Free; + {$ENDIF} + Buffer.Free; + inherited Destroy; + FreeAndNil(FGPSItems); +end; + +{$IFDEF USE_LAZINTFIMAGE} +procedure TMapView.CreateLazIntfImageAndCanvas(out ABuffer: TLazIntfImage; + out ACanvas: TFPCustomCanvas; AWidth, AHeight: Integer); +var + rawImg: TRawImage; +begin + rawImg.Init; + rawImg.Description.Init_BPP24_B8G8R8_BIO_TTB(AWidth, AHeight); + rawImg.CreateData(True); + ABuffer := TLazIntfImage.Create(rawImg, true); + ACanvas := TFPImageCanvas.Create(ABuffer); + ACanvas.Brush.FPColor := colWhite; + ACanvas.FillRect(0, 0, AWidth, AHeight); +end; +{$ENDIF} + +function TMapView.ScreenToLonLat(aPt: TPoint): TRealPoint; +begin + Result:=Engine.ScreenToLonLat(aPt); +end; + +function TMapView.LonLatToScreen(aPt: TRealPoint): TPoint; +begin + Result:=LonLatToScreen(aPt); +end; + +procedure TMapView.GetMapProviders(lstProviders: TStrings); +begin + Engine.GetMapProviders(lstProviders); +end; + +procedure TMapView.WaitEndOfRendering; +begin + Engine.Jobqueue.WaitAllJobTerminated(Engine); +end; + +procedure TMapView.CenterOnObj(obj: TGPSObj); +var Area : TRealArea; + Pt : TRealPoint; +begin + obj.GetArea(Area); + Pt.Lon:=(Area.TopLeft.Lon+Area.BottomRight.Lon) /2; + Pt.Lat:=(Area.TopLeft.Lat+Area.BottomRight.Lat) /2; + Center:=Pt; +end; + +procedure TMapView.ZoomOnObj(obj: TGPSObj); +var Area : TRealArea; +begin + obj.GetArea(Area); + Engine.ZoomOnArea(Area); +end; + +procedure TMapView.ZoomOnArea(const aArea: TRealArea); +begin + Engine.ZoomOnArea(aArea); +end; + +function TMapView.GetVisibleArea: TRealArea; +var aPt : TPoint; +begin + aPt.X:=0; + aPt.Y:=0; + Result.TopLeft:=Engine.ScreenToLonLat(aPt); + aPt.X:=Width; + aPt.Y:=Height; + Result.BottomRight:=Engine.ScreenToLonLat(aPt);; +end; + +procedure TMapView.ClearBuffer; +begin + {$IFDEF USE_LAZINTFIMAGE} + CreateLazIntfImageAndCanvas(Buffer, BufferCanvas, ClientWidth, ClientHeight); + {$ENDIF} +end; + +end. + diff --git a/components/lazmapviewer/source/mvmapviewer_icon.lrs b/components/lazmapviewer/source/mvmapviewer_icon.lrs new file mode 100644 index 000000000..0a19bbd24 --- /dev/null +++ b/components/lazmapviewer/source/mvmapviewer_icon.lrs @@ -0,0 +1,54 @@ +LazarusResources.Add('TMapViewer','PNG',[ + #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0 + +#0#0#6'bKGD'#0#255#0#255#0#255#160#189#167#147#0#0#0#9'pHYs'#0#0#11#19#0#0#11 + +#19#1#0#154#156#24#0#0#4#127'IDATH'#199#165#150#217'n'#20'W'#16#134#191':' + +#231#244'63'#158#5#143#205'"c'#2'Al'#10#216'(w'#201#3'D'#17#202#211'"'#30'!' + +#185#9#138#29#161#128#162#160#16#2'x'#155#177#199#179#245#222#231#228'b'#198 + +'c'#6'B'#20'%u'#211']'#173#174#255'T'#213#255'Wu'#203#147#221']'#231#128'@k' + +#186#181#144#184'(8I2.D!'#183#186'-'#146#188#228#217#209#9#255#213#12'@d4_^Y' + +'C'#128#131'I'#194#141'N'#11#17#8#148'b'#130#163#29#250#12#179#28#231#254#30 + +#196#211#138#210':'#220#252#5#1#206'^U'#206#193#221#181#14'''IF'#229#28'F'#9 + +'u_'#19#25#141#3'V'#195#128#245'z'#180#0#215'"l4'#235#212'<'#131#3#26#190'G' + +#168'5'#206'9D'#160'r'#142#235#157'&v'#30#160'.'#173#212'8'#156'$'#212'='#195 + +'o'#199'C'#154#129#191#148#169#18#225#221'x'#186#240'WB'#15#173#20'qQ"'#192 + +'8/'#24#229#197','#198#205#18'8'#156'&'#172'F!'#14'PqQ'#2'0'#201#11#250'q' + +#202'(/'#22#167'3/'#213'('#189#240'Gi'#193#171#193'h'#225#203#156#191#11#181 + +'`'#6'('#130#167#132'['#221#22#129'V'#168#202'Z'#140#18#6'i'#142#18#225'Eo' + +#192#193'4Y'#0#148#214#145#149#229#194#183#206#161'E'#150'8'#168'y'#134'A' + +#146#1'p'#183#219#230#254#250#5#4#161#29#5#168'n=$'#173'*.7"'#30'\\E'#139'0L' + +'s'#206'0Jk'#153#230#179'v'#156'U'#20'z'#134#134#167#169#220#140#216#180',Y' + +#171'G<'#188#212#165#19#5#243#170#133';'#171'mLd'#12#235#181#136#131'I'#140 + +#136#176'^'#143#24'e9'#130#144#219#138#231#189#1#145#167#201'+;S'#140#18#238 + +#172'D'#248#190#225'('#171#168#156#165#27#133'h'#165'(m'#181'T'#153'u'#14#181 + +'V'#11#17#129#180#172'(l'#133'u'#142#172#156']'#159#190#235'1'#201#11#174'4' + +#235#139#128#205'f'#157#17#130'C'#209#9#3'6'#155#13'j'#158'!'#208#138#186#231 + +'}$a'#5#240#250't'#194#222'8'#230#179'V'#147#154'g'#200'+'#203#211#189#30#213 + +#156#236'W'#131'1F)'#2#163#169'{'#30#135#211#148#10#136#188's'#242#229#3'^' + +#150#6#237#222'Z'#135'v'#24#160#4#174#183'W8I2FY'#190#164#148#150'o'#176#14 + +#178#170#226'j='#164'H'#19'"'#223#195'ZK^'#20'h'#165'p'#206#225#251'>UU!"h' + +#173'QY'#158'3'#156'N'#241'e'#150#237'/'#189#1'Z'#132#15#135#246'8'#201#216 + +'l5 '#137'I'#135'C'#252'0b'#146#164#140#227#152' '#8#240'<'#15#223#247#24#156 + +#158'.'#218'y|2'#192#4#190'O'#0#164'E'#193'8+8'#142'S*'#231'x'#191'`'#7'l' + +#214'B'#142#147#140#161#21'"'#17#252#188'@'#128#195#211'1'#27#8'e'#158'S'#139 + +'B:'#237'6'#206'9'#242#162#160#211'n'#161#242'|'#222#10#165'x'#222#31','#250 + +#254#161#137'o'#184#216#136'X'#247'=\'#16'r'#146#21#216'$'#230#218'j'#135#192 + +'h'#162'0$'#207#11'D'#4#17'!'#240'}'#140'R'#24#223#247#249#225#205#1'F'#169 + +'On'#196'P'#11'+'#206#18#26'M'''#10#184#28#248'T'#214'2'#173','#206'A?I'#209 + +#2'W'#218'-'#246#143#250'xF'#211'\Y!'#1#204#143'{='#174#214'Cz'#147#148'J'#9 + +'JdiU `'#16'|'#223''''#142#19#130#192#167#172','#198'h'#166#195'1Q'#24#240'v' + +#18'SX'#199#197'f'#131'WY'#201#26#138#184#223#231'u'#238'PYY'#241#199'8%'#21 + +#184#223#237#240#237#214#22#29'-'#139'V='#218#218'&'#174','#189'i'#194#149 + +#171'7X]'#223' '#201'RF'#163'1wn'#222#225#218#198'u'#190'y'#176#133#0'?'#237 + +#247#177#206'1*J'#250'N'#211'4z&S'#165#4'_+TY'#0#240#213#253'-^'#190'}'#197 + +#205#141#235#11#146#183'n'#223#227#241#206#14#235#129#199#198#213#207'y'#251 + +#231'K'#0#30#239#236#160'Dx'#180#189#205#147#221']'#0#10#231#232#134#1#158 + +#146#217#1#206'9'#226#162#196#206''''#241#244'x'#159#246#234'e'#190#255#245#5 + +'_'#223#190#187#180#186#147#185#190#178't'#182#220#190'{'#248#16'`'#1#14'PT' + +#150#189'I|>hg'#193#207#142#6#179#224','#227#224#232#29';'#251#253'%'#178#31 + +'mo/'#238#27#245#8#128#159#127#127#201#155#209#228'c'#213#1#155#173#198#249#1 + +#239'[YYv'#143'z'#31'=?'#203#242#209#246'6'#251#201'L'#222'o'#134#227'O'#174 + +#137#192'h'#228#201#238#238'B2'#13#223#227#139#245#14'/z'#167#12#223'['#21#31 + +'Ze'#29'J'#132'O'#224#158#15#168's'#231#21#184#249#242'z'#209';'#229'4'#203 + +#249#167'X'#173#228'_'#253'Q'#136#8'K'#211'U'#148#21'qQ.'#190'X"'#194#255#181 + +#191#0#1#137#23#12'Mu'#148#1#0#0#0#0'IEND'#174'B`'#130 +]); diff --git a/components/lazmapviewer/source/mvtypes.pas b/components/lazmapviewer/source/mvtypes.pas new file mode 100644 index 000000000..69a4f9323 --- /dev/null +++ b/components/lazmapviewer/source/mvtypes.pas @@ -0,0 +1,54 @@ +{ + (c) 2014 ti_dic + Parts of this component are based on : + Map Viewer 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. +} + +unit mvtypes; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +const + TILE_SIZE = 256; + +Type + { TArea } + TArea = record + top, left, bottom, right: Int64; + end; + + { TRealPoint } + TRealPoint = Record + Lon : Double; + Lat : Double; + end; + + { TRealArea } + TRealArea = Record + TopLeft : TRealPoint; + BottomRight : TRealPoint; + end; + +implementation + +end. +