LazMapViewer: Avoid crash of TMarkerClickPlugin when a click occurs between points. Support cursor change on points. Add OnCanClick event to disallow clicking on specific points.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9686 8e941d3f-bd1b-0410-a28a-d453659cc2b4

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"/>

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;

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
+  ClientHeight = 606
-  ClientWidth = 653
+  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
+    Height = 109
-    Top = 340
+    Top = 497
-    Width = 653
+    Width = 806
     Align = alBottom
     AutoSize = True
     BevelOuter = bvNone
-    ClientHeight = 86
+    ClientHeight = 109
-    ClientWidth = 653
+    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 = 104
-      Left = 379
       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

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.

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 }