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

LazMapViewer: Add options to TMarkerEditorPlugin to enable/disable adding/dragging/selecting points.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9715 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2025-03-31 21:54:53 +00:00
parent 5eaca89b50
commit 24b6e1099d
3 changed files with 147 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,24 +1,25 @@
object MainForm: TMainForm
Left = 513
Height = 690
Height = 656
Top = 157
Width = 908
Width = 706
Caption = 'Marker Editor Demo'
ClientHeight = 690
ClientWidth = 908
ClientHeight = 656
ClientWidth = 706
LCLVersion = '4.99.0.0'
OnCreate = FormCreate
object MapView: TMapView
Left = 0
Height = 453
Height = 400
Top = 0
Width = 908
Width = 706
Align = alClient
DownloadEngine = MapView.BuiltInDLE
DrawingEngine = MapView.BuiltInDE
Layers = <>
Font.Color = clBlack
MapProvider = 'Open Topo Map'
ParentFont = False
PluginManager = PluginManager
POIImages = POI_Images
TabOrder = 0
@ -26,7 +27,7 @@ object MainForm: TMainForm
object Bevel1: TBevel
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
Left = 451
Left = 350
Height = 50
Top = 108
Width = 6
@ -34,22 +35,22 @@ object MainForm: TMainForm
end
object Panel1: TPanel
Left = 0
Height = 237
Top = 453
Width = 908
Height = 256
Top = 400
Width = 706
Align = alBottom
AutoSize = True
BevelOuter = bvNone
ClientHeight = 237
ClientWidth = 908
ClientHeight = 256
ClientWidth = 706
TabOrder = 1
object cgPointTypes: TCheckGroup
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Panel1
Left = 8
Height = 70
Height = 89
Top = 8
Width = 363
Width = 279
AutoFill = True
AutoSize = True
BorderSpacing.Right = 8
@ -62,11 +63,12 @@ object MainForm: TMainForm
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.Layout = cclTopToBottomThenLeftToRight
ChildSizing.ControlsPerLine = 3
ClientHeight = 50
ClientWidth = 359
Columns = 3
ClientHeight = 69
ClientWidth = 275
ColumnLayout = clVerticalThenHorizontal
Columns = 2
Items.Strings = (
'GPSPointOfInterest'
'GPSTrackPoint'
@ -87,7 +89,7 @@ object MainForm: TMainForm
AnchorSideTop.Control = Label1
Left = 104
Height = 15
Top = 86
Top = 105
Width = 91
BorderSpacing.Left = 16
Caption = 'blue: MAP points'
@ -102,7 +104,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom
Left = 8
Height = 15
Top = 86
Top = 105
Width = 80
BorderSpacing.Bottom = 8
Caption = 'red: GPS points'
@ -113,9 +115,9 @@ object MainForm: TMainForm
object btnDeleteSelection: TButton
AnchorSideLeft.Control = rgNewPointType
AnchorSideLeft.Side = asrBottom
Left = 503
Left = 556
Height = 25
Top = 8
Top = 16
Width = 109
AutoSize = True
Caption = 'Delete selection'
@ -126,9 +128,9 @@ object MainForm: TMainForm
AnchorSideLeft.Control = btnDeleteSelection
AnchorSideTop.Control = btnDeleteSelection
AnchorSideTop.Side = asrBottom
Left = 503
Left = 556
Height = 25
Top = 33
Top = 41
Width = 111
AutoSize = True
Caption = 'Convert to track'
@ -139,9 +141,9 @@ object MainForm: TMainForm
AnchorSideLeft.Control = btnDeleteSelection
AnchorSideTop.Control = btnConvertToTrack
AnchorSideTop.Side = asrBottom
Left = 503
Left = 556
Height = 25
Top = 58
Top = 66
Width = 107
AutoSize = True
Caption = 'Convert to area'
@ -149,13 +151,13 @@ object MainForm: TMainForm
OnClick = btnConvertToAreaClick
end
object rgNewPointType: TRadioGroup
AnchorSideLeft.Control = cgPointTypes
AnchorSideLeft.Control = cgOptions
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
AnchorSideBottom.Control = btnConvertToArea
AnchorSideBottom.Side = asrBottom
Left = 387
Height = 67
Left = 440
Height = 75
Top = 8
Width = 100
Anchors = [akTop, akLeft, akBottom]
@ -171,7 +173,7 @@ object MainForm: TMainForm
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 47
ClientHeight = 55
ClientWidth = 96
ItemIndex = 0
Items.Strings = (
@ -187,11 +189,46 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom
Left = 8
Height = 120
Top = 109
Top = 128
Width = 437
BorderSpacing.Bottom = 8
Caption = 'Select a single point --> Left-click'#13#10'Select all points of track or area --> SHIFT+left-click'#13#10'Select all points contained in dragged rectangle --> ALT + left-click'#13#10'Create a new point --> Right-click'#13#10'Extend selection --> Hold CTRL key down and left-click'#13#10'Toggle selection of current point --> Hold CTRL key down and left-click'#13#10'Delete selection --> DEL key (or click "Delete selection" button'#13#10'Move selection --> Drag with mouse(left button down) or press arrow keys (+/- 1°)'
end
object cgOptions: TCheckGroup
AnchorSideLeft.Control = cgPointTypes
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
Left = 303
Height = 89
Top = 8
Width = 121
AutoFill = True
AutoSize = True
BorderSpacing.Right = 8
BorderSpacing.Around = 8
Caption = 'Allowed operations'
ChildSizing.LeftRightSpacing = 12
ChildSizing.TopBottomSpacing = 6
ChildSizing.HorizontalSpacing = 10
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 69
ClientWidth = 117
Items.Strings = (
'Add point'
'Select point(s)'
'Drag point(s)'
)
TabOrder = 5
OnItemClick = cgOptionsItemClick
Data = {
03000000020202
}
end
end
object PluginManager: TMvPluginManager
Left = 401

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

@ -19,6 +19,7 @@ type
btnConvertToTrack: TButton;
btnConvertToArea: TButton;
cgPointTypes: TCheckGroup;
cgOptions: TCheckGroup;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
@ -30,6 +31,7 @@ type
procedure btnDeleteSelectionClick(Sender: TObject);
procedure btnConvertToTrackClick(Sender: TObject);
procedure btnConvertToAreaClick(Sender: TObject);
procedure cgOptionsItemClick(Sender: TObject; Index: integer);
procedure cgPointTypesItemClick(Sender: TObject; Index: integer);
procedure FormCreate(Sender: TObject);
procedure rgNewPointTypeClick(Sender: TObject);
@ -178,6 +180,9 @@ begin
for i := 0 to cgPointTypes.Items.Count-1 do
cgPointTypes.Checked[i] := true;
for i := 0 to cgOptions.Items.Count-1 do
cgOptions.Checked[i] := true;
end;
procedure TMainForm.MapViewKeyDownHandler(Sender: TObject; var Key: Word;
@ -271,6 +276,18 @@ begin
inc(counter);
end;
procedure TMainForm.cgOptionsItemClick(Sender: TObject; Index: integer);
var
optns: TMarkerOptions;
begin
optns := Plugin.Options;
if cgOptions.Checked[Index] then
Include(optns, TMarkerOption(Index))
else
Exclude(optns, TMarkerOption(Index));
Plugin.Options := optns;
end;
procedure TMainForm.NewPointHandler(AMapView: TMapView; APoint: TGPSPoint);
begin
if (Plugin.NewPointType = nptMapPoint) and (APoint is TGPSPointOfInterest) then

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

@ -108,6 +108,7 @@ type
FMousePoint: TPoint;
FOrigGpsPoint: TGPSPoint;
FSavedCursor: TCursor;
function CanClick(AMapView: TMapView; APoint: TGPSPoint): Boolean; virtual;
procedure MouseDown(AMapView: TMapView; {%H-}Button: TMouseButton;
AShift: TShiftState; X,Y: Integer; var Handled: Boolean); override;
procedure MouseMove(AMapView: TMapView; {%H-}AShift: TShiftState;
@ -146,6 +147,9 @@ type
TMarkerNewPointType = (nptGPSPoint, nptMapPoint);
TMarkerOption = (moCanAddPoint, moCanSelectPoint, moCanDragPoint);
TMarkerOptions = set of TMarkerOption;
TMarkerEditorPlugin = class(TMarkerClickPlugin)
private
type
@ -153,6 +157,7 @@ type
TPluginState = set of TPluginStateEnum;
const
DEFAULT_CLICKMODE = cmSelectPoint;
DEFAULT_OPTIONS = [moCanDragPoint, moCanAddPoint, moCanSelectPoint];
DEFAULT_RUBBERBAND_BORDERCOLOR = clGray;
DEFAULT_RUBBERBAND_FILLCOLOR = clWhite;
DEFAULT_RUBBERBAND_OPACITY = 0.55;
@ -165,6 +170,7 @@ type
FClickMode: TMarkerClickMode;
FDragCursor: TCursor;
FNewPointType: TMarkerNewPointType;
FOptions: TMarkerOptions;
FRubberbandBorderColor: TColor;
FRubberbandFillColor: TColor;
FRubberbandOpacity: Single;
@ -185,8 +191,10 @@ type
FOnEndDrag: TNotifyEvent;
function IsOpacityStored: Boolean;
procedure SetExtendSelection(AValue: Boolean);
procedure SetOptions(AValue: TMarkerOptions);
protected
procedure AddToSelection(AMapView: TMapView; APoint: TGPSPoint; AExtendSelection: Boolean);
function CanClick(AMapView: TMapView; APoint: TGPSPoint): Boolean; override;
procedure DeleteFromList(AMapView: TMapView; APoint: TGPSPoint);
procedure DoSelectionChange(AMapView: TMapView);
procedure DragStart(AMapView: TMapView);
@ -231,6 +239,7 @@ type
property DragCursor: TCursor read FDragCursor write FDragCursor default crSizeAll;
// property ExtendSelection: Boolean read FExtendSelection write SetExtendSelection default false;
property NewPointType: TMarkerNewPointType read FNewPointType write FNewPointType default nptGPSPoint;
property Options: TMarkerOptions read FOptions write SetOptions default DEFAULT_OPTIONS;
property RubberbandBorderColor: TColor read FRubberbandBorderColor write FRubberbandBorderColor default DEFAULT_RUBBERBAND_BORDERCOLOR;
property RubberbandFillColor: TColor read FRubberbandFillColor write FRubberbandFillColor default DEFAULT_RUBBERBAND_FILLCOLOR;
property RubberbandOpacity: Single read FRubberbandOpacity write FRubberbandOpacity stored IsOpacityStored;
@ -398,10 +407,16 @@ begin
FShift := [ssLeft];
end;
function TCustomMarkerClickPlugin.CanClick(AMapView: TMapView;
APoint: TGPSPoint): Boolean;
begin
Result := true;
if Assigned(FOnCanClick) and Assigned(APoint) then
FOnCanClick(AMapView, APoint, Result);
end;
procedure TCustomMarkerClickPlugin.MouseDown(AMapView: TMapView;
Button: TMouseButton; AShift: TShiftState; X, Y: Integer; var Handled: Boolean);
var
canClick: Boolean;
begin
if Handled then
exit;
@ -409,13 +424,8 @@ begin
FOrigGPSPoint := FindNearestMarker(AMapView, X, Y);
if Assigned(FOrigGPSPoint) and (AShift = FShift) then
begin
if Assigned(FOnCanClick) then
begin
canClick := true;
FOnCanClick(AMapView, FOrigGPSPoint, canClick);
if not canClick then
if not CanClick(AMapView, FOrigGPSPoint) then
exit;
end;
if Assigned(FOnMarkerClick) then
FOnMarkerClick(AMapView, FOrigGPSPoint);
FMouseDownOnMarker := true;
@ -428,20 +438,14 @@ procedure TCustomMarkerClickPlugin.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;
if not FMouseDownOnMarker then
AMapView.Cursor := IfThen(canClick, FCursor, FSavedCursor);
begin
gpsPoint := FindNearestMarker(AMapView, X, Y);
AMapView.Cursor := IfThen(CanClick(AMapView, gpsPoint), FCursor, FSavedCursor);
end;
end;
procedure TCustomMarkerClickPlugin.MouseUp(AMapView: TMapView; Button: TMouseButton;
@ -493,6 +497,7 @@ begin
inherited;
FClickMode := DEFAULT_CLICKMODE;
FDragCursor := crSizeAll;
FOptions := DEFAULT_OPTIONS;
FRubberbandBorderColor := DEFAULT_RUBBERBAND_BORDERCOLOR;
FRubberbandFillColor := DEFAULT_RUBBERBAND_FILLCOLOR;
FRubberbandOpacity := DEFAULT_RUBBERBAND_OPACITY;
@ -515,6 +520,9 @@ procedure TMarkerEditorPlugin.AddToSelection(AMapView: TMapView;
var
idx: Integer;
begin
if not (moCanSelectPoint in FOptions) then
exit;
if AExtendSelection then
begin
idx := FSelection.IndexOf(APoint);
@ -539,6 +547,12 @@ begin
DrawRubberband(AMapView);
end;
function TMarkerEditorPlugin.CanClick(AMapView: TMapView;
APoint: TGPSPoint): Boolean;
begin
Result := inherited and (moCanSelectPoint in FOptions);
end;
function TMarkerEditorPlugin.ConvertSelectedPointsToGPSArea(
AMapView: TMapView; AreaID: Integer): TGPSArea;
var
@ -679,6 +693,8 @@ var
i: Integer;
canDrag: Boolean;
begin
if not (moCanDragPoint in FOptions) then
exit;
if Assigned(FOnStartDrag) then
begin
canDrag := true;
@ -971,23 +987,31 @@ end;
procedure TMarkerEditorPlugin.MouseDown(AMapView: TMapView;
{%H-}Button: TMouseButton; {%H-}AShift: TShiftState;
X, Y: Integer; var Handled: Boolean);
var
canAddPoint: Boolean;
canDragPoint: Boolean;
canSelectPoint: Boolean;
begin
if IsShiftOfClickMode(AShift, cmNewPoint) then
canAddPoint := moCanAddPoint in FOptions;
canDragPoint := moCanDragPoint in FOptions;
canSelectPoint := moCanSelectPoint in FOptions;
if IsShiftOfClickMode(AShift, cmNewPoint) and canAddPoint then
begin
FClickMode := cmNewPoint;
Shift := FShiftForNewPoint;
end else
if IsShiftOfClickMode(AShift, cmRubberband) then
if IsShiftOfClickMode(AShift, cmRubberband) and canSelectPoint then
begin
FClickMode := cmRubberband;
Shift := FShiftToSelectPoint;
end else
if IsShiftOfClickMode(AShift, cmSelectShape) then
if IsShiftOfClickMode(AShift, cmSelectShape) and canSelectPoint then
begin
FClickMode := cmSelectShape;
Shift := FShiftToSelectShape;
end else
if IsShiftOfClickMode(AShift, cmSelectPoint) then
if IsShiftOfClickMode(AShift, cmSelectPoint) and canSelectPoint then
begin
FClickMode := cmSelectPoint;
Shift := FShiftToSelectPoint;
@ -1137,6 +1161,9 @@ end;
procedure TMarkerEditorPlugin.RubberbandStart(AMapView: TMapView; X, Y: Integer);
begin
if not (moCanSelectPoint in FOptions) then
exit;
Include(FState, psRubberbandMode);
FRubberbandStartPt := Point(X, Y);
FRubberbandEndPt := Point(X, Y);
@ -1245,6 +1272,17 @@ begin
Update;
end;
procedure TMarkerEditorPlugin.SetOptions(AValue: TMarkerOptions);
begin
if AValue= FOptions then exit;
FOptions := AValue;
if not (moCanSelectPoint in FOptions) then
begin
FSelection.Clear;
Update;
end;
end;
procedure TMarkerEditorPlugin.UnselectPoint(AMapView: TMapView;
APoint: TGPSPoint);
var