LazMapViewer: Reverse dispatching order of mouse events in plugin manager. Add mouse-paint-order demo for it.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9565 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2025-01-05 17:49:49 +00:00 · 2025-01-05 17:49:49 +00:00 · fc1b7b9ccd
commit fc1b7b9ccd
parent 0f1b627cf4
7 changed files with 385 additions and 8 deletions
--- a/components/lazmapviewer/examples/plugin_demos/mousepaintorder_demo/project1.lpi
+++ b/components/lazmapviewer/examples/plugin_demos/mousepaintorder_demo/project1.lpi
@ -0,0 +1,89 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="project1"/>
+      <Scaled Value="True"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+      <Icon Value="0"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <RequiredPackages>
+      <Item>
+        <PackageName Value="lazMapViewerPkg"/>
+      </Item>
+      <Item>
+        <PackageName Value="LCL"/>
+      </Item>
+    </RequiredPackages>
+    <Units>
+      <Unit>
+        <Filename Value="project1.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="unit1.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="Unit1"/>
+      </Unit>
+      <Unit>
+        <Filename Value="udragcoloreditemplugin.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="uDragColoredItemPlugin"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="project1"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>
--- a/components/lazmapviewer/examples/plugin_demos/mousepaintorder_demo/project1.lpr
+++ b/components/lazmapviewer/examples/plugin_demos/mousepaintorder_demo/project1.lpr
@ -0,0 +1,25 @@
+program project1;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  cthreads,
+  {$ENDIF}
+  {$IFDEF HASAMIGA}
+  athreads,
+  {$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, unit1, uDragColoredItemPlugin
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource:=True;
+  Application.Scaled:=True;
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+
--- a/components/lazmapviewer/examples/plugin_demos/mousepaintorder_demo/udragcoloreditemplugin.pas
+++ b/components/lazmapviewer/examples/plugin_demos/mousepaintorder_demo/udragcoloreditemplugin.pas
@ -0,0 +1,172 @@
+unit uDragColoredItemPlugin;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Controls, Graphics,
+  mvPluginCore, mvPlugins, mvMapViewer, mvTypes, mvGPSObj, mvGeoMath;
+
+type
+
+  { TDragColoredItemPlugin }
+
+  TDragColoredItemPlugin = class(TMvPlugin)
+  private
+    FMouseDown : Boolean;
+    FCurrentCoord : TRealPoint;
+    FRectSize : Integer;
+    FColor : TColor;
+    function IsAtMousePosition(const X,Y: Integer) : Boolean;
+    procedure SetRectSize(Value : Integer);
+  protected
+    procedure AfterPaint(AMapView: TMapView; var Handled: Boolean); override;
+    procedure MouseMove(AMapView: TMapView; AShift: TShiftState; X,Y: Integer;
+          var Handled: Boolean); override;
+    procedure MouseUp(AMapView: TMapView; Button: TMouseButton; Shift: TShiftState;
+          X,Y: Integer; var Handled: Boolean); override;
+    procedure MouseDown(AMapView: TMapView; Button: TMouseButton; Shift: TShiftState;
+          X,Y: Integer; var Handled: Boolean); override;
+    procedure MouseWheel(AMapView: TMapView; AShift: TShiftState;
+      AWheelDelta: Integer; AMousePos: TPoint; var Handled: Boolean); override;
+  public
+    property Color : TColor read FColor write FColor;
+    property RectSize : Integer read FRectSize write SetRectSize;
+    constructor Create(AOwner: TComponent); override;
+  end;
+
+const
+  MinRectSize = 6;
+  MaxRectSize = 100;
+  DefaultRectSize = 20;
+
+implementation
+{ TDragColoredItemPlugin }
+
+function TDragColoredItemPlugin.IsAtMousePosition(const X, Y: Integer): Boolean;
+var
+  pt, ptc : TPoint;
+  aArea : TRealArea;
+  ptR : TRealPoint;
+  w2 : Integer;
+begin
+  Result := False;
+  pt.X := X;
+  pt.Y := Y;
+  ptR := MapView.ScreenToLatLon(pt);
+  ptc := MapView.LatLonToScreen(FCurrentCoord);
+  w2 := FRectSize div 2;
+  pt.X := ptc.X-w2;
+  pt.Y := ptc.Y-w2;
+  aArea.TopLeft := MapView.ScreenToLatLon(pt);
+  pt.X := ptc.X+w2;
+  pt.Y := ptc.Y+w2;
+  aArea.BottomRight := MapView.ScreenToLatLon(pt);
+  Result := False;
+  if PtInsideArea(ptR,aArea) then
+    Result := True;
+end;
+
+procedure TDragColoredItemPlugin.SetRectSize(Value: Integer);
+var
+  newsz : Integer;
+begin
+  if Value < MinRectSize then
+    newsz := MinRectSize
+  else if Value > MaxRectSize then
+    newsz := MaxRectSize
+  else
+    newsz := Value;
+  if FRectSize <> newsz then
+  begin
+     FRectSize := newsz;
+     MapView.Invalidate;
+  end;
+end;
+
+procedure TDragColoredItemPlugin.AfterPaint(AMapView: TMapView; var Handled: Boolean);
+var
+  ptCurrentScreen : TPoint;
+  s : String;
+  w2 : Integer;
+begin
+  MapView.Canvas.Pen.Style:= psSolid;
+  MapView.Canvas.Pen.Width:= 3;
+  MapView.Canvas.Pen.Color:= FColor;
+  ptCurrentScreen := MapView.LatLonToScreen(FCurrentCoord);
+  w2 := (FRectSize div 2);
+  MapView.Canvas.Rectangle(ptCurrentScreen.X-w2,ptCurrentScreen.Y-w2,
+                           ptCurrentScreen.X+w2,ptCurrentScreen.Y+w2);
+  s := Format('Index: %d',[Index]);
+  MapView.Canvas.TextOut(ptCurrentScreen.X+w2, ptCurrentScreen.Y+w2, s);
+end;
+
+procedure TDragColoredItemPlugin.MouseMove(AMapView: TMapView; AShift: TShiftState;
+  X, Y: Integer; var Handled: Boolean);
+begin
+  if FMouseDown then
+  begin
+    FCurrentCoord := MapView.ScreenToLatLon(Point(X,Y));
+    MapView.Invalidate;
+    Handled := True;
+    MapView.Cursor := crDefault;
+  end
+  else if not Handled then
+  begin
+    if IsAtMousePosition(X,Y) then
+    begin
+      MapView.Cursor := crHandPoint;
+      Handled := True;
+    end
+    else
+      MapView.Cursor := crDefault;
+  end;
+end;
+
+procedure TDragColoredItemPlugin.MouseUp(AMapView: TMapView; Button: TMouseButton;
+  Shift: TShiftState; X, Y: Integer; var Handled: Boolean);
+begin
+  if Button <> mbRight then Exit;
+  if FMouseDown then
+    MapView.Invalidate; // This will remove the two circles and the text
+  FMouseDown := False;
+  MapView.Cursor := crDefault;
+  Handled := True;
+end;
+
+procedure TDragColoredItemPlugin.MouseDown(AMapView: TMapView;
+  Button: TMouseButton; Shift: TShiftState; X, Y: Integer; var Handled: Boolean
+  );
+begin
+  if Button <> mbRight then Exit;
+  if Handled then Exit;
+  if IsAtMousePosition(X,Y) then
+  begin
+    FMouseDown := True;
+    FCurrentCoord := MapView.ScreenToLatLon(Point(X,Y));
+    Handled := True;
+    MapView.Invalidate;
+  end;
+end;
+
+procedure TDragColoredItemPlugin.MouseWheel(AMapView: TMapView;
+  AShift: TShiftState; AWheelDelta: Integer; AMousePos: TPoint;
+  var Handled: Boolean);
+begin
+  if Handled then Exit;
+  if IsAtMousePosition(AMousePos.X,AMousePos.Y) then
+  begin
+    Handled := True;
+    RectSize := RectSize + (AWheelDelta div 20);
+  end;
+end;
+
+constructor TDragColoredItemPlugin.Create(AOwner: TComponent);
+begin
+  inherited;
+  FRectSize := DefaultRectSize;
+end;
+
+end.
+
--- a/components/lazmapviewer/examples/plugin_demos/mousepaintorder_demo/unit1.lfm
+++ b/components/lazmapviewer/examples/plugin_demos/mousepaintorder_demo/unit1.lfm
@ -0,0 +1,38 @@
+object Form1: TForm1
+  Left = 324
+  Height = 323
+  Top = 119
+  Width = 429
+  Caption = 'Form1'
+  ClientHeight = 323
+  ClientWidth = 429
+  LCLVersion = '4.99.0.0'
+  OnCreate = FormCreate
+  object MapView1: TMapView
+    Left = 0
+    Height = 297
+    Top = 0
+    Width = 429
+    Active = True
+    Align = alClient
+    DownloadEngine = MapView1.BuiltInDLE
+    DrawingEngine = MapView1.BuiltInDE
+    Layers = <>
+    Font.Color = clBlack
+    MapProvider = 'OpenStreetMap Mapnik'
+    PluginManager = MvPluginManager1
+  end
+  object Panel1: TPanel
+    Left = 0
+    Height = 26
+    Top = 297
+    Width = 429
+    Align = alBottom
+    Caption = 'Drag the colored items with the right mouse button'
+    TabOrder = 1
+  end
+  object MvPluginManager1: TMvPluginManager
+    Left = 320
+    Top = 24
+  end
+end
--- a/components/lazmapviewer/examples/plugin_demos/mousepaintorder_demo/unit1.pas
+++ b/components/lazmapviewer/examples/plugin_demos/mousepaintorder_demo/unit1.pas
@ -0,0 +1,53 @@
+unit Unit1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, mvMapViewer,
+  mvPluginCore, uDragColoredItemPlugin, StdCtrls;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    MapView1: TMapView;
+    MvPluginManager1: TMvPluginManager;
+    Panel1: TPanel;
+    procedure FormCreate(Sender: TObject);
+  private
+
+  public
+
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm1 }
+const
+  PluginColors : array[0..8] of TColor = (
+    clFuchsia,clRed,$ff8c00,clYellow,clLime,clGreen,clNavy,clBlue,clAqua
+  );
+procedure TForm1.FormCreate(Sender: TObject);
+var
+  lDragColoredItemPlugin : TDragColoredItemPlugin;
+  i: Integer;
+begin
+  for i := 0 to High(PluginColors) do
+  begin
+    lDragColoredItemPlugin := TDragColoredItemPlugin.Create(Self);
+    lDragColoredItemPlugin.Color := PluginColors[i];
+    lDragColoredItemPlugin.MapView := MapView1;
+    MvPluginManager1.AddPlugin(lDragColoredItemPlugin);
+  end;
+end;
+
+end.
+
--- a/components/lazmapviewer/source/mvmapviewerreg.pas
+++ b/components/lazmapviewer/source/mvmapviewerreg.pas
@ -36,9 +36,9 @@ begin
    TMapTrack, 'Points', TMapTrackPointsPropertyEditor);

  RegisterPropertyEditor(TypeInfo(String),
-    TMapView,'MapProvider',TMapProviderPropertyEditor);
+    TMapView, 'MapProvider', TMapProviderPropertyEditor);
  RegisterPropertyEditor(TypeInfo(String),
-    TMapLayer,'MapProvider',TMapProviderPropertyEditor);
+    TMapLayer, 'MapProvider', TMapProviderPropertyEditor);
  RegisterPropertyEditor(TypeInfo(TImageIndex),
    TMapPointOfInterest, 'ImageIndex', TPointOfInterestImageIndexPropertyEditor);
  RegisterPropertyEditor(TypeInfo(TDateTime),
--- a/components/lazmapviewer/source/mvplugincore.pas
+++ b/components/lazmapviewer/source/mvplugincore.pas
@ -1056,7 +1056,7 @@ var
  plugin: TMvCustomPlugin;
 begin
  Result := false;
-  for i := 0 to FPluginList.Count-1 do
+  for i := FPluginList.Count-1 downto 0 do
  begin
    plugin := Items[i];
    if HandlePlugin(plugin, AMapView) then
@ -1070,7 +1070,7 @@ var
  plugin: TMvCustomPlugin;
 begin
  Result := false;
-  for i := 0 to FPluginList.Count-1 do
+  for i := FPluginList.Count-1 downto 0 do
  begin
    plugin := Items[i];
    if HandlePlugin(plugin, AMapView) then
@ -1084,7 +1084,7 @@ var
  plugin: TMvCustomPlugin;
 begin
  Result := false;
-  for i := 0 to FPluginList.Count-1 do
+  for i := FPluginList.Count-1 downto 0 do
  begin
    plugin := Items[i];
    if HandlePlugin(plugin, AMapView) then
@ -1099,7 +1099,7 @@ var
  plugin: TMvCustomPlugin;
 begin
  Result := false;
-  for i := 0 to FPluginList.Count-1 do
+  for i := FPluginList.Count-1 downto 0 do
  begin
    plugin := Items[i];
    if HandlePlugin(plugin, AMapView) then
@ -1114,7 +1114,7 @@ var
  plugin: TMvCustomPlugin;
 begin
  Result := false;
-  for i := 0 to FPluginList.Count-1 do
+  for i := FPluginList.Count-1 downto 0 do
  begin
    plugin := Items[i];
    if HandlePlugin(plugin, AMapView) then
@ -1129,7 +1129,7 @@ var
  plugin: TMvCustomPlugin;
 begin
  Result := False;
-  for i := 0 to FPluginList.Count-1 do
+  for i := FPluginList.Count-1 downto 0 do
  begin
    plugin := Items[i];
    if HandlePlugin(plugin, AMapView) then