diff --git a/components/lazmapviewer/examples/plugin_demos/markerclick_demo/MarkerClick_Demo.lpi b/components/lazmapviewer/examples/plugin_demos/markerclick_demo/MarkerClick_Demo.lpi
index b533dca9f..1e4f3904d 100644
--- a/components/lazmapviewer/examples/plugin_demos/markerclick_demo/MarkerClick_Demo.lpi
+++ b/components/lazmapviewer/examples/plugin_demos/markerclick_demo/MarkerClick_Demo.lpi
@@ -5,7 +5,7 @@
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
- <Title Value="MarkerClick_Demo"/>
+ <Title Value="Marker Click Demo"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
diff --git a/components/lazmapviewer/examples/plugin_demos/markerclick_demo/MarkerClick_Demo.lpr b/components/lazmapviewer/examples/plugin_demos/markerclick_demo/MarkerClick_Demo.lpr
index a1fd391c4..594ff7ac7 100644
--- a/components/lazmapviewer/examples/plugin_demos/markerclick_demo/MarkerClick_Demo.lpr
+++ b/components/lazmapviewer/examples/plugin_demos/markerclick_demo/MarkerClick_Demo.lpr
@@ -17,6 +17,7 @@ uses
begin
RequireDerivedFormResource := True;
+ Application.Title:='Marker Click Demo';
Application.Scaled:=True;
{$PUSH}{$WARN 5044 OFF}
Application.MainFormOnTaskbar := True;
diff --git a/components/lazmapviewer/examples/plugin_demos/markerclick_demo/main.lfm b/components/lazmapviewer/examples/plugin_demos/markerclick_demo/main.lfm
index a46013b2d..394398a2d 100644
--- a/components/lazmapviewer/examples/plugin_demos/markerclick_demo/main.lfm
+++ b/components/lazmapviewer/examples/plugin_demos/markerclick_demo/main.lfm
@@ -1,18 +1,18 @@
object MainForm: TMainForm
Left = 576
- Height = 426
+ Height = 606
Top = 248
- Width = 653
+ Width = 806
Caption = 'Marker Click Demo'
- ClientHeight = 426
- ClientWidth = 653
+ ClientHeight = 606
+ ClientWidth = 806
LCLVersion = '4.99.0.0'
OnCreate = FormCreate
object MapView: TMapView
Left = 0
- Height = 340
+ Height = 497
Top = 0
- Width = 653
+ Width = 806
Align = alClient
Cyclic = True
DownloadEngine = MapView.BuiltInDLE
@@ -22,11 +22,28 @@ object MainForm: TMainForm
MapProvider = 'Open Topo Map'
PluginManager = PluginManager
POIImages = POI_Images
+ object Memo: TMemo
+ Left = 603
+ Height = 497
+ Top = 0
+ Width = 203
+ Align = alRight
+ ScrollBars = ssAutoBoth
+ TabOrder = 0
+ end
+ object Splitter1: TSplitter
+ Left = 598
+ Height = 497
+ Top = 0
+ Width = 5
+ Align = alRight
+ ResizeAnchor = akRight
+ end
end
object Bevel1: TBevel
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
- Left = 323
+ Left = 400
Height = 50
Top = 108
Width = 6
@@ -34,14 +51,14 @@ object MainForm: TMainForm
end
object Panel1: TPanel
Left = 0
- Height = 86
- Top = 340
- Width = 653
+ Height = 109
+ Top = 497
+ Width = 806
Align = alBottom
AutoSize = True
BevelOuter = bvNone
- ClientHeight = 86
- ClientWidth = 653
+ ClientHeight = 109
+ ClientWidth = 806
TabOrder = 1
object cgPointTypes: TCheckGroup
AnchorSideLeft.Control = Panel1
@@ -81,13 +98,12 @@ object MainForm: TMainForm
}
end
object Label2: TLabel
- AnchorSideLeft.Control = cgPointTypes
+ AnchorSideLeft.Control = Label1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label1
- AnchorSideTop.Side = asrBottom
- Left = 379
+ Left = 104
Height = 15
- Top = 23
+ Top = 86
Width = 91
BorderSpacing.Left = 16
Caption = 'blue: MAP points'
@@ -98,18 +114,51 @@ object MainForm: TMainForm
end
object Label1: TLabel
AnchorSideLeft.Control = cgPointTypes
- AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = cgPointTypes
- Left = 379
+ AnchorSideTop.Side = asrBottom
+ Left = 8
Height = 15
- Top = 8
+ Top = 86
Width = 80
- BorderSpacing.Left = 16
+ BorderSpacing.Bottom = 8
Caption = 'red: GPS points'
Font.Color = clRed
ParentColor = False
ParentFont = False
end
+ object rgClickBehaviour: TRadioGroup
+ AnchorSideLeft.Control = cgPointTypes
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = Panel1
+ AnchorSideBottom.Control = cgPointTypes
+ AnchorSideBottom.Side = asrBottom
+ Left = 379
+ Height = 70
+ Top = 8
+ Width = 125
+ Anchors = [akTop, akLeft, akBottom]
+ AutoFill = True
+ AutoSize = True
+ BorderSpacing.Left = 16
+ BorderSpacing.Top = 8
+ Caption = 'Click behaviour'
+ ChildSizing.LeftRightSpacing = 10
+ ChildSizing.HorizontalSpacing = 10
+ ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+ ChildSizing.EnlargeVertical = crsHomogenousChildResize
+ ChildSizing.ShrinkHorizontal = crsScaleChilds
+ ChildSizing.ShrinkVertical = crsScaleChilds
+ ChildSizing.Layout = cclLeftToRightThenTopToBottom
+ ChildSizing.ControlsPerLine = 1
+ ClientHeight = 50
+ ClientWidth = 121
+ ItemIndex = 0
+ Items.Strings = (
+ 'Show dialog'
+ 'Log click points'
+ )
+ TabOrder = 1
+ end
end
object PluginManager: TMvPluginManager
Left = 401
diff --git a/components/lazmapviewer/examples/plugin_demos/markerclick_demo/main.pas b/components/lazmapviewer/examples/plugin_demos/markerclick_demo/main.pas
index d98faecd2..9e1e89e36 100644
--- a/components/lazmapviewer/examples/plugin_demos/markerclick_demo/main.pas
+++ b/components/lazmapviewer/examples/plugin_demos/markerclick_demo/main.pas
@@ -18,14 +18,18 @@ type
cgPointTypes: TCheckGroup;
Label1: TLabel;
Label2: TLabel;
+ Memo: TMemo;
Panel1: TPanel;
POI_Images: TImageList;
MapView: TMapView;
PluginManager: TMvPluginManager;
+ rgClickBehaviour: TRadioGroup;
+ Splitter1: TSplitter;
procedure cgPointTypesItemClick(Sender: TObject; Index: integer);
procedure FormCreate(Sender: TObject);
private
Plugin: TMarkerClickPlugin;
+ procedure MarkerCanClickHandler(AMapView: TMapView; APoint: TGPSPoint; var CanClick: Boolean);
procedure MarkerClickHandler({%H-}AMapView: TMapView; APoint: TGPSPoint);
public
@@ -124,6 +128,8 @@ begin
Plugin := TMarkerClickPlugin.Create(PluginManager);
Plugin.OnMarkerClick := @MarkerClickHandler;
+ Plugin.OnCanClick := @MarkerCanClickHandler;
+ // Plugin.MapView := MapView; // Required if the MapView has a non-default cursor.
for i := 0 to cgPointTypes.Items.Count-1 do
cgPointTypes.Checked[i] := true;
@@ -141,6 +147,21 @@ begin
Plugin.PointTypes := pointTypes;
end;
+procedure TMainForm.MarkerCanClickHandler(AMapView: TMapView; APoint: TGPSPoint;
+ var CanClick: Boolean);
+var
+ mapTrack: TMapTrack;
+ i: Integer;
+begin
+ // Disallow clicking on the points of the (blue) map track
+ mapTrack := MapView.Layers[0].Tracks[0];
+ for i := 0 to mapTrack.Points.Count-1 do
+ begin
+ CanClick := not APoint.RealPoint.Equal(mapTrack.Points[i].RealPoint);
+ if not CanClick then exit;
+ end;
+end;
+
procedure TMainForm.MarkerClickHandler(AMapView: TMapView; APoint: TGPSPoint);
var
s, sName, sLat, sLon: String;
@@ -148,10 +169,13 @@ begin
sName := APoint.Name;
sLat := ' Latitude ' + LatToStr(APoint.Lat, true);
sLon := ' Longitude ' + LonToStr(APoint.Lon, true);
- s := sLat + Lineending + sLon;
+ s := sLat + LineEnding + sLon;
if sName <> '' then
s := sName + LineEnding + s;
- ShowMessage(s);
+ case rgClickBehaviour.ItemIndex of
+ 0: ShowMessage(s);
+ 1: Memo.Lines.Add(s + LineEnding);
+ end;
end;
end.
diff --git a/components/lazmapviewer/source/addons/plugins/mvplugins.pas b/components/lazmapviewer/source/addons/plugins/mvplugins.pas
index 549783162..86277d7f3 100644
--- a/components/lazmapviewer/source/addons/plugins/mvplugins.pas
+++ b/components/lazmapviewer/source/addons/plugins/mvplugins.pas
@@ -138,19 +138,28 @@ type
{ TMarkerClickPlugin }
+ TMarkerCanClickEvent = procedure (AMapView: TMapView; APoint: TGPSPoint; var CanClick: Boolean) of object;
TMarkerClickEvent = procedure (AMapView: TMapView; APoint: TGPSPoint) of object;
TMarkerClickPlugin = class(TMvMarkerPlugin)
private
+ FCursor: TCursor;
+ FSavedCursor: TCursor;
FShift: TShiftState;
+ FOnCanClick: TMarkerCanClickEvent;
FOnMarkerClick: TMarkerClickEvent;
protected
procedure MouseDown(AMapView: TMapView; {%H-}Button: TMouseButton;
AShift: TShiftState; X,Y: Integer; var Handled: Boolean); override;
+ procedure MouseMove(AMapView: TMapView; {%H-}AShift: TShiftState;
+ X,Y: Integer; var Handled: Boolean); override;
+ procedure SetMapView(AValue: TMapView); override;
public
constructor Create(AOwner: TComponent); override;
published
+ property Cursor: TCursor read FCursor write FCursor default crHandPoint;
property Shift: TShiftState read FShift write FShift default [ssLeft];
+ property OnCanClick: TMarkerCanClickEvent read FOnCanClick write FOnCanClick;
property OnMarkerClick: TMarkerClickEvent read FOnMarkerClick write FOnMarkerClick;
end;
@@ -351,6 +360,12 @@ implementation
uses
Types;
+function IfThen(AValue: Boolean; ACursor1, ACursor2: TCursor): TCursor;
+begin
+ if AValue then Result := ACursor1 else Result := ACursor2;
+end;
+
+
{ TCenterMargerPlugin }
constructor TCenterMarkerPlugin.Create(AOwner: TComponent);
@@ -928,6 +943,8 @@ end;
constructor TMarkerClickPlugin.Create(AOwner: TComponent);
begin
inherited;
+ FCursor := crHandPoint;
+ FSavedCursor := crDefault;
FShift := [ssLeft];
end;
@@ -935,18 +952,57 @@ procedure TMarkerClickPlugin.MouseDown(AMapView: TMapView; Button: TMouseButton;
AShift: TShiftState; X, Y: Integer; var Handled: Boolean);
var
gpsPoint: TGPSPoint;
+ canClick: Boolean;
begin
if Handled then
exit;
gpsPoint := FindNearestMarker(AMapView, X, Y);
- if Assigned(FOnMarkerClick) and (AShift = FShift) then
+ if Assigned(gpsPoint) and Assigned(FOnMarkerClick) and (AShift = FShift) then
begin
+ if Assigned(FOnCanClick) then
+ begin
+ canClick := true;
+ FOnCanClick(AMapView, gpsPoint, canClick);
+ if not canClick then
+ exit;
+ end;
FOnMarkerClick(AMapView, gpsPoint);
Handled := true;
end;
end;
+procedure TMarkerClickPlugin.MouseMove(AMapView: TMapView;
+ {%H-}AShift: TShiftState; X,Y: Integer; var Handled: Boolean);
+var
+ gpsPoint: TGPSPoint;
+ canClick: Boolean;
+begin
+ if Handled then
+ exit;
+ gpsPoint := FindNearestMarker(AMapView, X, Y);
+ if Assigned(gpsPoint) then
+ begin
+ canClick := true;
+ if Assigned(FOnCanClick) then
+ FOnCanClick(AMapView, gpsPoint, canClick);
+ end else
+ canClick := false;
+ AMapView.Cursor := IfThen(canClick, FCursor, FSavedCursor);
+end;
+
+{ Store the original MapView cursor. Is used when the mouse is not over a
+ clickable point. If no MapView is assigned to the plugin it is assumed that
+ the MapView has the default cursor. }
+procedure TMarkerClickPlugin.SetMapView(AValue: TMapView);
+begin
+ inherited;
+ if Assigned(MapView) then
+ FSavedCursor := MapView.Cursor
+ else
+ FSavedCursor := crDefault;
+end;
+
{ TMarkerHintPlugin }