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,'
',#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 = '';
+ LONG_ID = '';
+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('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('',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('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;
+
+ { 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;
+
+ { 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.LonArea2.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=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.LonArea.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 (aValuehigh(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 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.
+
|