lazmapviewer: Add event OnDrawGpsPoint for custom drawing of gps points.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6796 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2019-01-18 16:54:16 +00:00
parent da045c8ab0
commit 0a3e34cd0b
3 changed files with 61 additions and 3 deletions

View File

@ -392,6 +392,7 @@ object MainForm: TMainForm
UseThreads = True
Zoom = 0
OnZoomChange = MapViewZoomChange
OnDrawGpsPoint = MapViewDrawGpsPoint
OnMouseMove = MapViewMouseMove
OnMouseUp = MapViewMouseUp
end

View File

@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils, Types, Forms, Controls, Graphics, Dialogs,
ExtCtrls, StdCtrls, ComCtrls,
mvGeoNames, mvMapViewer, mvTypes;
mvGeoNames, mvMapViewer, mvTypes, mvGpsObj;
type
@ -54,6 +54,7 @@ type
procedure FormShow(Sender: TObject);
procedure GeoNamesNameFound(const AName: string; const ADescr: String;
const ALoc: TRealPoint);
procedure MapViewDrawGpsPoint(Sender, ACanvas: TObject; APoint: TGpsPoint);
procedure MapViewMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure MapViewMouseUp(Sender: TObject; Button: TMouseButton;
@ -80,7 +81,8 @@ implementation
{$R *.lfm}
uses
LCLType, IniFiles, Math, mvGpsObj, mvExtraData,
LCLType, IniFiles, Math, FPCanvas, FPImage, IntfGraphics,
mvExtraData,
gpslistform;
type
@ -244,6 +246,47 @@ begin
CbFoundLocations.Items.AddObject(AName, P);
end;
procedure TMainForm.MapViewDrawGpsPoint(Sender, ACanvas: TObject;
APoint: TGpsPoint);
const
R = 5;
var
P: TPoint;
cnv: TFPCustomCanvas;
txt: String;
w, h: Integer;
bmp: TBitmap;
img: TLazIntfImage;
begin
// Screen coordinates of the GPS point
P := TMapView(Sender).LonLatToScreen(APoint.RealPoint);
// Draw the GPS point as a circle
cnv := TFPCustomCanvas(ACanvas);
cnv.Brush.FPColor := colRed;
cnv.Ellipse(P.X-R, P.Y-R, P.X+R, P.Y+R);
// Draw the "name" of the GPS point. Note: FPCustomCanvas, by default,
// does not support text output. Therefore we paint to a bitmap first and
// render this on the FPCustomCanvas.
txt := APoint.Name;
bmp := TBitmap.Create;
try
bmp.PixelFormat := pf32Bit;
w := bmp.Canvas.TextWidth(txt);
h := bmp.Canvas.TextHeight(txt);
bmp.SetSize(w, h);
bmp.Canvas.Brush.Color := clWhite;
bmp.Canvas.FillRect(0, 0, w, h);
bmp.Canvas.TextOut(0, 0, txt);
img := bmp.CreateIntfImage;
cnv.Draw(P.X - w div 2, P.Y - h - 2*R, img);
img.Free;
finally
bmp.Free;
end;
end;
procedure TMainForm.MapViewMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
const

View File

@ -39,6 +39,8 @@ uses
Type
TDrawGpsPointEvent = procedure (Sender, ACanvas: TObject; APoint: TGpsPoint) of object;
{ TMapView }
TMapView = class(TCustomControl)
@ -56,6 +58,7 @@ Type
FGPSItems: TGPSObjectList;
FInactiveColor: TColor;
FPOIImage: TBitmap;
FOnDrawGpsPoint: TDrawGpsPointEvent;
procedure CallAsyncInvalidate;
procedure DoAsyncInvalidate(Data: PtrInt);
procedure DrawObjects(const TileId: TTileId; aLeft, aTop, aRight,aBottom: integer);
@ -131,6 +134,7 @@ Type
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;
@ -579,6 +583,16 @@ 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
@ -772,7 +786,7 @@ end;
function TMapView.LonLatToScreen(aPt: TRealPoint): TPoint;
begin
Result:=LonLatToScreen(aPt);
Result:=Engine.LonLatToScreen(aPt);
end;
procedure TMapView.GetMapProviders(lstProviders: TStrings);