{ (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, MvDownloadEngine; Type TDrawGpsPointEvent = procedure (Sender, ACanvas: TObject; APoint: TGpsPoint) of object; { TMapView } TMapView = class(TCustomControl) private FDownloadEngine: TMvCustomDownloadEngine; FBuiltinDownloadEngine: TMvCustomDownloadEngine; FEngine: TMapViewerEngine; {$IFDEF USE_RGBGRAPHICS} Buffer: TRGB32Bitmap; {$ENDIF} {$IFDEF USE_LAZINTFIMAGE} Buffer: TLazIntfImage; BufferCanvas: TFPCustomCanvas; {$ENDIF} FActive: boolean; FGPSItems: TGPSObjectList; FInactiveColor: TColor; FPOIImage: TBitmap; FOnDrawGpsPoint: TDrawGpsPointEvent; procedure CallAsyncInvalidate; procedure DoAsyncInvalidate({%H-}Data: PtrInt); procedure DrawObjects(const {%H-}TileId: TTileId; aLeft, aTop, aRight,aBottom: integer); procedure DrawPt(const {%H-}Area: TRealArea;aPOI: TGPSPoint); procedure DrawTrack(const Area: TRealArea;trk: TGPSTrack); function GetCacheOnDisk: boolean; function GetCachePath: String; function GetCenter: TRealPoint; function GetDownloadEngine: TMvCustomDownloadEngine; 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({%H-}AValue: String); procedure SetCenter(AValue: TRealPoint); procedure SetDownloadEngine(AValue: TMvCustomDownloadEngine); 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; procedure SaveToFile(AClass: TRasterImageClass; const AFileName: String); function SaveToImage(AClass: TRasterImageClass): TRasterImage; procedure SaveToStream(AClass: TRasterImageClass; AStream: TStream); 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 DownloadEngine: TMvCustomDownloadEngine read GetDownloadEngine write SetDownloadEngine; 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 OnDrawGpsPoint: TDrawGpsPointEvent read FOnDrawGpsPoint write FOnDrawGpsPoint; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; end; implementation uses {$IFDEF USE_LAZINTFIMAGE} Math, FPImgCanv, FPImage, LCLVersion, {$ENDIF} GraphType, mvJobQueue, mvExtraData, mvDLEFpc; {$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 Viewer.DrawTrack(FArea, TGPSTrack(Obj)); if Obj.InheritsFrom(TGPSPoint) then Viewer.DrawPt(FArea, TGPSPoint(Obj)); 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.GetDownloadEngine: TMvCustomDownloadEngine; begin if FDownloadEngine = nil then Result := FBuiltinDownloadEngine else Result := FDownloadEngine; 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.SetDownloadEngine(AValue: TMvCustomDownloadEngine); begin FDownloadEngine := AValue; FEngine.DownloadEngine := GetDownloadEngine; 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); Engine.Active := IsActive; 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, 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, Y: Integer); 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.PixelFormat := pf32Bit; 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.DrawTrack(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 if Assigned(FOnDrawGpsPoint) then begin {$IFDEF USE_RGBGRAPHICS} FOnDrawGpsPoint(Self, Buffer, aPOI); {$ENDIF} {$IFDEF USE_LAZINTFIMAGE} FOnDrawGpsPoint(Self, BufferCanvas, aPOI); {$ENDIF} exit; end; 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; 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); {$IFDEF USE_RGBGRAPHICS} var temp: TRGB32Bitmap; ri: TRawImage; BuffLaz: TLazIntfImage; {$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); FBuiltinDownloadEngine := TMvDEFpc.Create(self); FBuiltinDownLoadEngine.Name := 'BuiltIn'; {$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 := FBuiltinDownloadEngine; 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; {$IFDEF DARWIN} rawImg.Description.Init_BPP32_A8R8G8B8_BIO_TTB(AWidth, AHeight); {$ELSE} rawImg.Description.Init_BPP32_B8G8R8_BIO_TTB(AWidth, AHeight); {$ENDIF} rawImg.CreateData(True); ABuffer := TLazIntfImage.Create(rawImg, true); ACanvas := TFPImageCanvas.Create(ABuffer); ACanvas.Brush.FPColor := colWhite; ACanvas.FillRect(0, 0, AWidth, AHeight); end; {$ENDIF} procedure TMapView.SaveToFile(AClass: TRasterImageClass; const AFileName: String); var stream: TFileStream; begin stream := TFileStream.Create(AFileName, fmCreate + fmShareDenyNone); try SaveToStream(AClass, stream); finally stream.Free; end; end; function TMapView.SaveToImage(AClass: TRasterImageClass): TRasterImage; begin Result := AClass.Create; Result.Width := Width; Result.Height := Height; Result.Canvas.FillRect(0, 0, Width, Height); {$IFDEF USE_RGBGRAPHICS} Buffer.Canvas.DrawTo(Result.Canvas,0,0); {$ENDIF} {$IFDEF USE_LAZINTFIMAGE} Result.LoadFromIntfImage(Buffer); {$ENDIF} end; procedure TMapView.SaveToStream(AClass: TRasterImageClass; AStream: TStream); var img: TRasterImage; begin img := SaveToImage(AClass); try img.SaveToStream(AStream); finally img.Free; end; end; function TMapView.ScreenToLonLat(aPt: TPoint): TRealPoint; begin Result:=Engine.ScreenToLonLat(aPt); end; function TMapView.LonLatToScreen(aPt: TRealPoint): TPoint; begin Result:=Engine.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.