From bbef9faf386b90e7814cd8b96c04e234a938fda7 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 23 Apr 2019 19:50:39 +0000 Subject: [PATCH] lazmapviewer: Add methods to extract full buffer bitmap (SaveToImage) and to save it to file (SaveToFile) or stream (SaveToStream). Forum request https://forum.lazarus.freepascal.org/index.php/topic,12674.msg318676.html#msg318676 git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6861 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/lazmapviewer/example/main.lfm | 14 +++++++ components/lazmapviewer/example/main.pas | 8 ++++ .../lazmapviewer/source/mvmapviewer.pas | 41 +++++++++++++++++++ 3 files changed, 63 insertions(+) diff --git a/components/lazmapviewer/example/main.lfm b/components/lazmapviewer/example/main.lfm index 7837a2551..06e291f58 100644 --- a/components/lazmapviewer/example/main.lfm +++ b/components/lazmapviewer/example/main.lfm @@ -492,6 +492,20 @@ object MainForm: TMainForm } OnClick = BtnSaveMapProvidersClick end + object BtnSaveToFile: TButton + AnchorSideLeft.Control = BtnGPSPoints + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = BtnGPSPoints + Left = 108 + Height = 25 + Top = 347 + Width = 110 + AutoSize = True + BorderSpacing.Left = 8 + Caption = 'Save map to file' + OnClick = BtnSaveToFileClick + TabOrder = 11 + end end object MapView: TMapView Left = 0 diff --git a/components/lazmapviewer/example/main.pas b/components/lazmapviewer/example/main.pas index 11e844ea3..51989a462 100644 --- a/components/lazmapviewer/example/main.pas +++ b/components/lazmapviewer/example/main.pas @@ -17,6 +17,7 @@ type BtnSearch: TButton; BtnGoTo: TButton; BtnGPSPoints: TButton; + BtnSaveToFile: TButton; CbDoubleBuffer: TCheckBox; CbFoundLocations: TComboBox; CbLocations: TComboBox; @@ -46,6 +47,7 @@ type procedure BtnGoToClick(Sender: TObject); procedure BtnSearchClick(Sender: TObject); procedure BtnGPSPointsClick(Sender: TObject); + procedure BtnSaveToFileClick(Sender: TObject); procedure CbDoubleBufferChange(Sender: TObject); procedure CbFoundLocationsDrawItem(Control: TWinControl; Index: Integer; ARect: TRect; State: TOwnerDrawState); @@ -175,6 +177,12 @@ begin MapView.Invalidate; end; +procedure TMainForm.BtnSaveToFileClick(Sender: TObject); +begin + MapView.SaveToFile(TPortableNetworkGraphic, 'mapview.png'); + ShowMessage('Map saved to "mapview.png".'); +end; + procedure TMainForm.CbDoubleBufferChange(Sender: TObject); begin MapView.DoubleBuffered := CbDoubleBuffer.Checked; diff --git a/components/lazmapviewer/source/mvmapviewer.pas b/components/lazmapviewer/source/mvmapviewer.pas index 0220cc592..50a698da1 100644 --- a/components/lazmapviewer/source/mvmapviewer.pas +++ b/components/lazmapviewer/source/mvmapviewer.pas @@ -116,6 +116,9 @@ Type 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); @@ -798,6 +801,44 @@ begin 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);