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
2025-03-18 11:24:45 +00:00 · 2025-03-18 11:24:45 +00:00 · cc5dd7eb5e
commit cc5dd7eb5e
parent a1e91b1045
5 changed files with 154 additions and 24 deletions
--- 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"/>
--- 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;
--- 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
--- 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.
--- 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 }