paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

LazMapviewer: Use intermediate class TCustomMarkerClickPlugin to have more control on published properties. Rename some identifiers.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9699 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2025-03-24 12:22:10 +00:00
parent 8441d2546f
commit f7d9f1cbd8
3 changed files with 48 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
components/lazmapviewer/examples/plugin_demos/markereditor_demo/main.lfm
View File

@ -113,7 +113,7 @@ object MainForm: TMainForm
AnchorSideLeft.Control = cgPointTypes AnchorSideLeft.Control = cgPointTypes
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1 AnchorSideTop.Control = Panel1
AnchorSideBottom.Control = cbMultiSelect AnchorSideBottom.Control = cbExtendSelection
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 387 Left = 387
Height = 127 Height = 127
@ -137,25 +137,25 @@ object MainForm: TMainForm
ItemIndex = 1 ItemIndex = 1
Items.Strings = ( Items.Strings = (
'Create new point' 'Create new point'
'Add point to selection' 'Select point'
'Add shape to selection' 'Select points of shape'
'Toggle selected point' 'Toggle selected point'
'Select by dragging rectangle' 'Select by dragging rectangle'
) )
TabOrder = 1 TabOrder = 1
OnClick = rgClickModeClick OnClick = rgClickModeClick
end end
object cbMultiSelect: TCheckBox object cbExtendSelection: TCheckBox
AnchorSideLeft.Control = rgNewPointType AnchorSideLeft.Control = rgNewPointType
AnchorSideTop.Control = rgNewPointType AnchorSideTop.Control = rgNewPointType
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 599 Left = 599
Height = 19 Height = 19
Top = 83 Top = 83
Width = 77 Width = 103
Caption = 'MultiSelect' Caption = 'Extend selection'
TabOrder = 2 TabOrder = 2
OnChange = cbMultiSelectChange OnChange = cbExtendSelectionChange
end end
object btnDeleteSelection: TButton object btnDeleteSelection: TButton
AnchorSideLeft.Control = rgNewPointType AnchorSideLeft.Control = rgNewPointType

8
components/lazmapviewer/examples/plugin_demos/markereditor_demo/main.pas
View File

@ -19,7 +19,7 @@ type
btnConvertToTrack: TButton; btnConvertToTrack: TButton;
btnConvertToArea: TButton; btnConvertToArea: TButton;
cgPointTypes: TCheckGroup; cgPointTypes: TCheckGroup;
cbMultiSelect: TCheckBox; cbExtendSelection: TCheckBox;
Label1: TLabel; Label1: TLabel;
Label2: TLabel; Label2: TLabel;
Panel1: TPanel; Panel1: TPanel;
@ -32,7 +32,7 @@ type
procedure btnConvertToTrackClick(Sender: TObject); procedure btnConvertToTrackClick(Sender: TObject);
procedure btnConvertToAreaClick(Sender: TObject); procedure btnConvertToAreaClick(Sender: TObject);
procedure cgPointTypesItemClick(Sender: TObject; Index: integer); procedure cgPointTypesItemClick(Sender: TObject; Index: integer);
procedure cbMultiSelectChange(Sender: TObject); procedure cbExtendSelectionChange(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure rgClickModeClick(Sender: TObject); procedure rgClickModeClick(Sender: TObject);
procedure rgNewPointTypeClick(Sender: TObject); procedure rgNewPointTypeClick(Sender: TObject);
@ -247,9 +247,9 @@ begin
inc(counter); inc(counter);
end; end;
procedure TMainForm.cbMultiSelectChange(Sender: TObject); procedure TMainForm.cbExtendSelectionChange(Sender: TObject);
begin begin
Plugin.MultiSelect := cbMultiSelect.Checked; Plugin.ExtendSelection := cbExtendSelection.Checked;
end; end;
procedure TMainForm.NewPointHandler(AMapView: TMapView; APoint: TGPSPoint); procedure TMainForm.NewPointHandler(AMapView: TMapView; APoint: TGPSPoint);

66
components/lazmapviewer/source/addons/plugins/markers/mvmarkerplugins.pas
View File

@ -92,17 +92,17 @@ type
end; end;
{ TMarkerClickPlugin } { TCustomMarkerClickPlugin }
TMarkerCanClickEvent = procedure (AMapView: TMapView; APoint: TGPSPoint; var CanClick: Boolean) of object; TMarkerCanClickEvent = procedure (AMapView: TMapView; APoint: TGPSPoint; var CanClick: Boolean) of object;
TMarkerClickEvent = procedure (AMapView: TMapView; APoint: TGPSPoint) of object; TMarkerClickEvent = procedure (AMapView: TMapView; APoint: TGPSPoint) of object;
TMarkerClickPlugin = class(TMvMarkerPlugin) TCustomMarkerClickPlugin = class(TMvMarkerPlugin)
private private
FCursor: TCursor; FCursor: TCursor;
FShift: TShiftState;
FOnCanClick: TMarkerCanClickEvent; FOnCanClick: TMarkerCanClickEvent;
FOnMarkerClick: TMarkerClickEvent; FOnMarkerClick: TMarkerClickEvent;
FShift: TShiftState;
protected protected
FMouseDownOnMarker: Boolean; FMouseDownOnMarker: Boolean;
FMousePoint: TPoint; FMousePoint: TPoint;
@ -115,16 +115,23 @@ type
procedure MouseUp({%H-}AMapView: TMapView; {%H-}Button: TMouseButton; procedure MouseUp({%H-}AMapView: TMapView; {%H-}Button: TMouseButton;
{%H-}AShift: TShiftState; {%H-}X,{%H-}Y: Integer; var {%H-}Handled: Boolean); override; {%H-}AShift: TShiftState; {%H-}X,{%H-}Y: Integer; var {%H-}Handled: Boolean); override;
procedure SetMapView(AValue: TMapView); override; procedure SetMapView(AValue: TMapView); override;
property Shift: TShiftState read FShift write FShift default [ssLeft];
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
published published
property Cursor: TCursor read FCursor write FCursor default crHandPoint; 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 OnCanClick: TMarkerCanClickEvent read FOnCanClick write FOnCanClick;
property OnMarkerClick: TMarkerClickEvent read FOnMarkerClick write FOnMarkerClick; property OnMarkerClick: TMarkerClickEvent read FOnMarkerClick write FOnMarkerClick;
end; end;
{ TMarkerClickPlugin }
TMarkerClickPlugin = class(TCustomMarkerClickPlugin)
published
property Shift;
end;
{ TMarkerEditorPlugin } { TMarkerEditorPlugin }
TMarkerDrawPointEvent = procedure (AMapView: TMapView; TMarkerDrawPointEvent = procedure (AMapView: TMapView;
@ -135,15 +142,15 @@ type
TMarkerStartDragEvent = procedure (AMapView: TMapView; var CanDrag: Boolean) of object; TMarkerStartDragEvent = procedure (AMapView: TMapView; var CanDrag: Boolean) of object;
TMarkerClickMode = (cmNewPoint, cmAddPointToSelection, cmAddShapeToSelection, TMarkerClickMode = (cmNewPoint, cmSelectPoint, cmSelectShape,
cmToggleSelectedPoint, cmRubberband); cmTogglePoint, cmRubberband);
TMarkerNewPointType = (nptGPSPoint, nptMapPoint); TMarkerNewPointType = (nptGPSPoint, nptMapPoint);
TMarkerEditorPlugin = class(TMarkerClickPlugin) TMarkerEditorPlugin = class(TMarkerClickPlugin)
private private
const const
DEFAULT_CLICKMODE = cmAddPointToSelection; DEFAULT_CLICKMODE = cmSelectPoint;
DEFAULT_RUBBERBAND_BORDERCOLOR = clGray; DEFAULT_RUBBERBAND_BORDERCOLOR = clGray;
DEFAULT_RUBBERBAND_FILLCOLOR = clWhite; DEFAULT_RUBBERBAND_FILLCOLOR = clWhite;
DEFAULT_RUBBERBAND_OPACITY = 0.55; DEFAULT_RUBBERBAND_OPACITY = 0.55;
@ -151,7 +158,7 @@ type
FClickMode: TMarkerClickMode; FClickMode: TMarkerClickMode;
FDragCursor: TCursor; FDragCursor: TCursor;
FDragging: Boolean; FDragging: Boolean;
FMultiSelect: Boolean; FExtendSelection: Boolean;
FNewPointType: TMarkerNewPointType; FNewPointType: TMarkerNewPointType;
FRubberbandBorderColor: TColor; FRubberbandBorderColor: TColor;
FRubberbandFillColor: TColor; FRubberbandFillColor: TColor;
@ -167,7 +174,7 @@ type
FOnStartDrag: TMarkerStartDragEvent; FOnStartDrag: TMarkerStartDragEvent;
FOnEndDrag: TNotifyEvent; FOnEndDrag: TNotifyEvent;
function IsOpacityStored: Boolean; function IsOpacityStored: Boolean;
procedure SetMultiSelect(AValue: Boolean); procedure SetExtendSelection(AValue: Boolean);
protected protected
procedure AddToSelection(AMapView: TMapView; APoint: TGPSPoint; AExtendSelection: Boolean); procedure AddToSelection(AMapView: TMapView; APoint: TGPSPoint; AExtendSelection: Boolean);
procedure DeleteFromList(AMapView: TMapView; APoint: TGPSPoint); procedure DeleteFromList(AMapView: TMapView; APoint: TGPSPoint);
@ -211,11 +218,12 @@ type
published published
property ClickMode: TMarkerClickMode read FClickMode write FClickMode default DEFAULT_CLICKMODE; property ClickMode: TMarkerClickMode read FClickMode write FClickMode default DEFAULT_CLICKMODE;
property DragCursor: TCursor read FDragCursor write FDragCursor default crSizeAll; property DragCursor: TCursor read FDragCursor write FDragCursor default crSizeAll;
property MultiSelect: Boolean read FMultiSelect write SetMultiSelect default false; property ExtendSelection: Boolean read FExtendSelection write SetExtendSelection default false;
property NewPointType: TMarkerNewPointType read FNewPointType write FNewPointType default nptGPSPoint; property NewPointType: TMarkerNewPointType read FNewPointType write FNewPointType default nptGPSPoint;
property RubberbandBorderColor: TColor read FRubberbandBorderColor write FRubberbandBorderColor default DEFAULT_RUBBERBAND_BORDERCOLOR; property RubberbandBorderColor: TColor read FRubberbandBorderColor write FRubberbandBorderColor default DEFAULT_RUBBERBAND_BORDERCOLOR;
property RubberbandFillColor: TColor read FRubberbandFillColor write FRubberbandFillColor default DEFAULT_RUBBERBAND_FILLCOLOR; property RubberbandFillColor: TColor read FRubberbandFillColor write FRubberbandFillColor default DEFAULT_RUBBERBAND_FILLCOLOR;
property RubberbandOpacity: Single read FRubberbandOpacity write FRubberbandOpacity stored IsOpacityStored; property RubberbandOpacity: Single read FRubberbandOpacity write FRubberbandOpacity stored IsOpacityStored;
property Shift;
property OnDrawPoint: TMarkerDrawPointEvent read FOnDrawPoint write FOnDrawPoint; property OnDrawPoint: TMarkerDrawPointEvent read FOnDrawPoint write FOnDrawPoint;
property OnEndDrag: TNotifyEvent read FOnEndDrag write FOnEndDrag; property OnEndDrag: TNotifyEvent read FOnEndDrag write FOnEndDrag;
property OnNewPoint: TMarkerNewPointEvent read FOnNewPoint write FOnNewPoint; property OnNewPoint: TMarkerNewPointEvent read FOnNewPoint write FOnNewPoint;
@ -360,9 +368,9 @@ begin
end; end;
{ TMarkerClickPlugin } { TCustomMarkerClickPlugin }
constructor TMarkerClickPlugin.Create(AOwner: TComponent); constructor TCustomMarkerClickPlugin.Create(AOwner: TComponent);
begin begin
inherited; inherited;
FCursor := crHandPoint; FCursor := crHandPoint;
@ -370,8 +378,8 @@ begin
FShift := [ssLeft]; FShift := [ssLeft];
end; end;
procedure TMarkerClickPlugin.MouseDown(AMapView: TMapView; Button: TMouseButton; procedure TCustomMarkerClickPlugin.MouseDown(AMapView: TMapView;
AShift: TShiftState; X, Y: Integer; var Handled: Boolean); Button: TMouseButton; AShift: TShiftState; X, Y: Integer; var Handled: Boolean);
var var
canClick: Boolean; canClick: Boolean;
begin begin
@ -396,7 +404,7 @@ begin
end; end;
end; end;
procedure TMarkerClickPlugin.MouseMove(AMapView: TMapView; procedure TCustomMarkerClickPlugin.MouseMove(AMapView: TMapView;
{%H-}AShift: TShiftState; X,Y: Integer; var Handled: Boolean); {%H-}AShift: TShiftState; X,Y: Integer; var Handled: Boolean);
var var
gpsPoint: TGPSPoint; gpsPoint: TGPSPoint;
@ -416,7 +424,7 @@ begin
AMapView.Cursor := IfThen(canClick, FCursor, FSavedCursor); AMapView.Cursor := IfThen(canClick, FCursor, FSavedCursor);
end; end;
procedure TMarkerClickPlugin.MouseUp(AMapView: TMapView; Button: TMouseButton; procedure TCustomMarkerClickPlugin.MouseUp(AMapView: TMapView; Button: TMouseButton;
AShift: TShiftState; X, Y: Integer; var Handled: Boolean); AShift: TShiftState; X, Y: Integer; var Handled: Boolean);
begin begin
FMouseDownOnMarker := false; FMouseDownOnMarker := false;
@ -425,7 +433,7 @@ end;
{ Store the original MapView cursor. Is used when the mouse is not over a { 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 clickable point. If no MapView is assigned to the plugin it is assumed that
the MapView has the default cursor. } the MapView has the default cursor. }
procedure TMarkerClickPlugin.SetMapView(AValue: TMapView); procedure TCustomMarkerClickPlugin.SetMapView(AValue: TMapView);
begin begin
inherited; inherited;
if Assigned(MapView) then if Assigned(MapView) then
@ -929,11 +937,11 @@ begin
if FMouseDownOnMarker then if FMouseDownOnMarker then
begin begin
case FClickMode of case FClickMode of
cmAddPointToSelection: cmSelectPoint:
AddToSelection(AMapView, FOrigGPSPoint, FMultiSelect); AddToSelection(AMapView, FOrigGPSPoint, FExtendSelection);
cmAddShapeToSelection: cmSelectShape:
SelectAllPointsOfShape(AMapView, FOrigGPSPoint, FMultiSelect); SelectAllPointsOfShape(AMapView, FOrigGPSPoint, FExtendSelection);
cmToggleSelectedPoint: cmTogglePoint:
ToggleSelected(AMapView, FOrigGPSPoint); ToggleSelected(AMapView, FOrigGPSPoint);
end; end;
Update; Update;
@ -944,7 +952,7 @@ begin
cmNewPoint: cmNewPoint:
begin begin
FOrigGPSPoint := NewPoint(AMapView, X, Y); FOrigGPSPoint := NewPoint(AMapView, X, Y);
AddToSelection(AMapView, FOrigGPSPoint, FMultiSelect); AddToSelection(AMapView, FOrigGPSPoint, FExtendSelection);
Handled := true; Handled := true;
end; end;
cmRubberband: cmRubberband:
@ -1133,7 +1141,7 @@ var
pts: TGPSObjArray; pts: TGPSObjArray;
i: Integer; i: Integer;
begin begin
if not FMultiSelect then if not FExtendSelection then
FSelection.Clear; FSelection.Clear;
R := RubberbandRect; R := RubberbandRect;
area.TopLeft := AMapView.ScreenToLatLon(R.TopLeft); area.TopLeft := AMapView.ScreenToLatLon(R.TopLeft);
@ -1144,11 +1152,11 @@ begin
Update; Update;
end; end;
procedure TMarkerEditorPlugin.SetMultiSelect(AValue: Boolean); procedure TMarkerEditorPlugin.SetExtendSelection(AValue: Boolean);
begin begin
if FMultiSelect = AValue then exit; if FExtendSelection = AValue then exit;
FMultiSelect := AValue; FExtendSelection := AValue;
if (not FMultiSelect) then if (not FExtendSelection) then
begin begin
FSelection.Clear; FSelection.Clear;
if (FOrigGPSPoint <> nil) then if (FOrigGPSPoint <> nil) then
@ -1165,7 +1173,7 @@ begin
idx := FSelection.IndexOf(APoint); idx := FSelection.IndexOf(APoint);
if idx = -1 then if idx = -1 then
begin begin
if not FMultiSelect then if not FExtendSelection then
FSelection.Clear; FSelection.Clear;
FSelection.Add(APoint); FSelection.Add(APoint);
end else end else