pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6861 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-04-23 19:50:39 +00:00
parent 3f8f7e96fd
commit bbef9faf38
3 changed files with 63 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
components/lazmapviewer/example/main.lfm
View File

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

8
components/lazmapviewer/example/main.pas
View File

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

41
components/lazmapviewer/source/mvmapviewer.pas
View File

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