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

@@ -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

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;

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);