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

LazMapViewer: Replace TMarkerEditorPlugin properties ClickMode and ExtendSelection by key combinations in Shift* properties. Update demp.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9701 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2025-03-24 19:17:34 +00:00
parent 7677def6cf
commit 0c94a4cd90
3 changed files with 138 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,18 +1,18 @@
object MainForm: TMainForm
Left = 513
Height = 566
Height = 690
Top = 157
Width = 833
Width = 908
Caption = 'Marker Editor Demo'
ClientHeight = 566
ClientWidth = 833
ClientHeight = 690
ClientWidth = 908
LCLVersion = '4.99.0.0'
OnCreate = FormCreate
object MapView: TMapView
Left = 0
Height = 423
Height = 468
Top = 0
Width = 833
Width = 908
Align = alClient
DownloadEngine = MapView.BuiltInDLE
DrawingEngine = MapView.BuiltInDE
@ -21,11 +21,12 @@ object MainForm: TMainForm
MapProvider = 'Open Topo Map'
PluginManager = PluginManager
POIImages = POI_Images
TabOrder = 0
end
object Bevel1: TBevel
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
Left = 413
Left = 451
Height = 50
Top = 108
Width = 6
@ -33,14 +34,14 @@ object MainForm: TMainForm
end
object Panel1: TPanel
Left = 0
Height = 143
Top = 423
Width = 833
Height = 222
Top = 468
Width = 908
Align = alBottom
AutoSize = True
BevelOuter = bvNone
ClientHeight = 143
ClientWidth = 833
ClientHeight = 222
ClientWidth = 908
TabOrder = 1
object cgPointTypes: TCheckGroup
AnchorSideLeft.Control = Panel1
@ -109,100 +110,51 @@ object MainForm: TMainForm
ParentColor = False
ParentFont = False
end
object rgClickMode: TRadioGroup
AnchorSideLeft.Control = cgPointTypes
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
AnchorSideBottom.Control = cbExtendSelection
AnchorSideBottom.Side = asrBottom
Left = 387
Height = 127
Top = 8
Width = 196
AutoFill = True
AutoSize = True
BorderSpacing.Right = 8
BorderSpacing.Around = 8
Caption = 'Click mode'
ChildSizing.LeftRightSpacing = 12
ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 107
ClientWidth = 192
ItemIndex = 1
Items.Strings = (
'Create new point'
'Select point'
'Select points of shape'
'Toggle selected point'
'Select by dragging rectangle'
)
TabOrder = 1
OnClick = rgClickModeClick
end
object cbExtendSelection: TCheckBox
AnchorSideLeft.Control = rgNewPointType
AnchorSideTop.Control = rgNewPointType
AnchorSideTop.Side = asrBottom
Left = 599
Height = 19
Top = 83
Width = 103
Caption = 'Extend selection'
TabOrder = 2
OnChange = cbExtendSelectionChange
end
object btnDeleteSelection: TButton
AnchorSideLeft.Control = rgNewPointType
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = rgClickMode
Left = 715
Left = 503
Height = 25
Top = 8
Width = 109
AutoSize = True
Caption = 'Delete selection'
TabOrder = 3
TabOrder = 1
OnClick = btnDeleteSelectionClick
end
object btnConvertToTrack: TButton
AnchorSideLeft.Control = btnDeleteSelection
AnchorSideTop.Control = btnDeleteSelection
AnchorSideTop.Side = asrBottom
Left = 715
Left = 503
Height = 25
Top = 33
Width = 111
AutoSize = True
Caption = 'Convert to track'
TabOrder = 4
TabOrder = 2
OnClick = btnConvertToTrackClick
end
object btnConvertToArea: TButton
AnchorSideLeft.Control = btnDeleteSelection
AnchorSideTop.Control = btnConvertToTrack
AnchorSideTop.Side = asrBottom
Left = 715
Left = 503
Height = 25
Top = 58
Width = 107
AutoSize = True
Caption = 'Convert to area'
TabOrder = 5
TabOrder = 3
OnClick = btnConvertToAreaClick
end
object rgNewPointType: TRadioGroup
AnchorSideLeft.Control = rgClickMode
AnchorSideLeft.Control = cgPointTypes
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
AnchorSideBottom.Control = btnConvertToArea
AnchorSideBottom.Side = asrBottom
Left = 599
Left = 387
Height = 67
Top = 8
Width = 100
@ -226,9 +178,20 @@ object MainForm: TMainForm
'TGPSPoint'
'TMapPoint'
)
TabOrder = 6
TabOrder = 4
OnClick = rgNewPointTypeClick
end
object Label3: TLabel
AnchorSideLeft.Control = Label1
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
Left = 8
Height = 105
Top = 109
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'#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
end
object PluginManager: TMvPluginManager
Left = 401

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

@ -19,25 +19,24 @@ type
btnConvertToTrack: TButton;
btnConvertToArea: TButton;
cgPointTypes: TCheckGroup;
cbExtendSelection: TCheckBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Panel1: TPanel;
POI_Images: TImageList;
MapView: TMapView;
PluginManager: TMvPluginManager;
rgNewPointType: TRadioGroup;
rgClickMode: TRadioGroup;
procedure btnDeleteSelectionClick(Sender: TObject);
procedure btnConvertToTrackClick(Sender: TObject);
procedure btnConvertToAreaClick(Sender: TObject);
procedure cgPointTypesItemClick(Sender: TObject; Index: integer);
procedure cbExtendSelectionChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure rgClickModeClick(Sender: TObject);
procedure rgNewPointTypeClick(Sender: TObject);
private
Plugin: TMarkerEditorPlugin;
procedure MapViewKeyDownHandler(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure NewPointHandler(AMapView: TMapView; APoint: TGPSPoint);
public
@ -174,13 +173,38 @@ begin
Plugin := TMarkerEditorPlugin.Create(PluginManager);
Plugin.OnNewPoint := @NewPointHandler;
MapView.TabStop := true;
MapView.OnKeyDown := @MapViewKeydownHandler;
for i := 0 to cgPointTypes.Items.Count-1 do
cgPointTypes.Checked[i] := true;
end;
procedure TMainForm.rgClickModeClick(Sender: TObject);
procedure TMainForm.MapViewKeyDownHandler(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Plugin.ClickMode := TMarkerClickMode(rgClickMode.ItemIndex);
if MapView.Focused then
case Key of
VK_DELETE:
if (Plugin.Selection.Count > 0) and
(MessageDlg('Delete selected points?', mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
begin
Plugin.DeleteSelectedPoints(MapView);
end;
VK_LEFT:
Plugin.MoveSelectionBy(MapView, -1.0, 0.0);
VK_RIGHT:
Plugin.MoveSelectionBy(MapView, +1.0, 0.0);
VK_UP:
Plugin.MoveSelectionBy(MapView, 0.0, 1.0);
VK_DOWN:
Plugin.MoveSelectionBy(MapView, 0.0, -1.0);
else
inherited;
exit;
end;
MapView.Invalidate;
Key := 0;
end;
procedure TMainForm.rgNewPointTypeClick(Sender: TObject);
@ -247,11 +271,6 @@ begin
inc(counter);
end;
procedure TMainForm.cbExtendSelectionChange(Sender: TObject);
begin
Plugin.ExtendSelection := cbExtendSelection.Checked;
end;
procedure TMainForm.NewPointHandler(AMapView: TMapView; APoint: TGPSPoint);
begin
if (Plugin.NewPointType = nptMapPoint) and (APoint is TGPSPointOfInterest) then

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

@ -154,6 +154,11 @@ type
DEFAULT_RUBBERBAND_BORDERCOLOR = clGray;
DEFAULT_RUBBERBAND_FILLCOLOR = clWhite;
DEFAULT_RUBBERBAND_OPACITY = 0.55;
DEFAULT_SHIFT_FOR_NEW_POINT = [ssRight];
DEFAULT_SHIFT_TO_SELECT_POINT = [ssLeft];
DEFAULT_SHIFT_TO_SELECT_SHAPE = [ssLeft, ssShift];
DEFAULT_SHIFT_TO_SELECT_BY_RUBBERBAND = [ssLeft, ssAlt];
DEFAULT_SHIFT_TO_EXTEND_SELECTION = [ssCtrl]; // to be used in addition to the others
private
FClickMode: TMarkerClickMode;
FDragCursor: TCursor;
@ -167,6 +172,11 @@ type
FRubberbandStartPt: TPoint;
FRubberbandEndPt: TPoint;
FSelection: TGPSPointList;
FShiftForNewPoint: TShiftState;
FShiftToSelectPoint: TShiftState;
FShiftToSelectShape: TShiftState;
FShiftToSelectByRubberband: TShiftState;
FShiftToExtendSelection: TShiftState;
FOrigSelection: array of TRealPoint; // Selection before dragging starts
FOnDrawPoint: TMarkerDrawPointEvent;
FOnNewPoint: TMarkerNewPointEvent;
@ -188,6 +198,7 @@ type
procedure DrawSelection(AMapView: TMapView);
procedure FindContainerOfPoint(AMapView: TMapView; APoint: TGPSPoint; var AContainer: TGPSObj; var AIndex: Integer);
procedure FindMapCollection(AMapView: TMapView; APoint: TGPSPoint; var ACollection: TMapCollectionBase; var AIndex: Integer);
function IsShiftOfClickMode(AShift: TShiftState; AClickMode: TMarkerClickMode): Boolean;
function RubberbandRect: TRect;
procedure RubberbandStart(AMapView: TMapView; X, Y: Integer);
procedure RubberbandTo(AMapView: TMapView; X, Y: Integer);
@ -216,14 +227,23 @@ type
procedure SelectInRubberband(AMapView: TMapView);
property Selection: TGPSPointList read FSelection;
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 ExtendSelection: Boolean read FExtendSelection write SetExtendSelection default false;
// property ExtendSelection: Boolean read FExtendSelection write SetExtendSelection default false;
property NewPointType: TMarkerNewPointType read FNewPointType write FNewPointType default nptGPSPoint;
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;
property Shift;
property ShiftForNewPoint: TShiftState read FShiftForNewPoint write FShiftForNewPoint
default DEFAULT_SHIFT_FOR_NEW_POINT;
property ShiftToExtendSelection: TShiftState read FShiftToExtendSelection write FShiftToExtendSelection
default DEFAULT_SHIFT_TO_EXTEND_SELECTION;
property ShiftToSelectPoint: TShiftState read FShiftToSelectPoint write FShiftToSelectPoint
default DEFAULT_SHIFT_TO_SELECT_POINT;
property ShiftToSelectShape: TShiftState read FShiftToSelectShape write FShiftToSelectShape
default DEFAULT_SHIFT_TO_SELECT_SHAPE;
property ShiftToSelectByRubberband: TShiftState read FShiftToSelectByRubberband write FShiftToSelectByRubberband
default DEFAULT_SHIFT_TO_SELECT_BY_RUBBERBAND;
property OnDrawPoint: TMarkerDrawPointEvent read FOnDrawPoint write FOnDrawPoint;
property OnEndDrag: TNotifyEvent read FOnEndDrag write FOnEndDrag;
property OnNewPoint: TMarkerNewPointEvent read FOnNewPoint write FOnNewPoint;
@ -477,6 +497,11 @@ begin
FRubberbandFillColor := DEFAULT_RUBBERBAND_FILLCOLOR;
FRubberbandOpacity := DEFAULT_RUBBERBAND_OPACITY;
FSelection := TGPSPointList.Create(false); // false = do not free objects
FShiftForNewPoint := DEFAULT_SHIFT_FOR_NEW_POINT;
FShiftToSelectPoint := DEFAULT_SHIFT_TO_SELECT_POINT;
FShiftToSelectShape := DEFAULT_SHIFT_TO_SELECT_SHAPE;
FShiftToSelectByRubberband := DEFAULT_SHIFT_TO_SELECT_BY_RUBBERBAND;
FShiftToExtendSelection := [ssCtrl]; // modifier to the others to add point(s) to current selection
end;
destructor TMarkerEditorPlugin.Destroy;
@ -889,7 +914,26 @@ begin
Result := FRubberbandOpacity <> DEFAULT_RUBBERBAND_OPACITY;
end;
{ Moves the selection by the given amound of pixels in x and y direction. }
function TMarkerEditorPlugin.IsShiftOfClickMode(AShift: TShiftState;
AClickMode: TMarkerClickMode): Boolean;
begin
case AClickMode of
cmNewPoint:
Result := (AShift = FShiftForNewPoint) or
(AShift = FShiftForNewPoint + FShiftToExtendSelection);
cmSelectPoint:
Result := (AShift = FShiftToSelectPoint) or
(AShift = FShiftToSelectPoint + FShiftToExtendSelection);
cmSelectShape:
Result := (AShift = FShiftToSelectShape) or
(AShift = FShiftToSelectShape + FShiftToExtendSelection);
cmRubberband:
Result := (AShift = FShiftToSelectByRubberband) or
(AShift = FShiftToSelectByRubberBand + FShiftToExtendSelection);
end;
end;
{ Moves the selection by the given pixel count in x and y direction. }
procedure TMarkerEditorPlugin.MoveSelectionBy(AMapView: TMapView; dx, dy: Integer);
var
i: Integer;
@ -906,7 +950,7 @@ begin
end;
end;
{ Moves the selection by the given amound of degrees in x and y direction }
{ Moves the selection by the given amount of degrees in x and y direction }
procedure TMarkerEditorPlugin.MoveSelectionBy(AMapView: TMapView; dx, dy: Double);
var
i: Integer;
@ -918,10 +962,6 @@ begin
rPt := FSelection[i].RealPoint;
rPt.Lon := FSelection[i].Lon + dX;
rPt.Lat := FSelection[i].Lat + dY;
if rPt.Lat > 90 then
rPt.Lat := rPt.Lat - 180;
if rPt.Lon < -90 then
rPt.Lon := rPt.Lon + 180;
P := AMapView.LatLonToScreen(rPt);
rPt := AMapView.ScreenToLatLon(P);
FSelection[i].MoveTo(rPt.Lon, rPt.Lat);
@ -932,6 +972,31 @@ procedure TMarkerEditorPlugin.MouseDown(AMapView: TMapView;
{%H-}Button: TMouseButton; {%H-}AShift: TShiftState;
X, Y: Integer; var Handled: Boolean);
begin
if IsShiftOfClickMode(AShift, cmNewPoint) then
begin
FClickMode := cmNewPoint;
Shift := FShiftForNewPoint;
end else
if IsShiftOfClickMode(AShift, cmRubberband) then
begin
FClickMode := cmRubberband;
Shift := FShiftToSelectPoint;
end else
if IsShiftOfClickMode(AShift, cmSelectShape) then
begin
FClickMode := cmSelectShape;
Shift := FShiftToSelectShape;
end else
if IsShiftOfClickMode(AShift, cmSelectPoint) then
begin
FClickMode := cmSelectPoint;
Shift := FShiftToSelectPoint;
end else
exit;
FExtendSelection := (AShift * FShiftToExtendSelection = FShiftToExtendSelection);
if FExtendSelection then Shift := Shift + FShiftToExtendSelection;
inherited;
if FMouseDownOnMarker then
@ -989,7 +1054,7 @@ begin
DragTo(AMapView, X, Y);
Handled := true;
end else
if not FDragging and (FClickMode = cmRubberband) and (Shift = AShift) then
if not FDragging and (FClickMode = cmRubberband) and IsShiftOfClickMode(AShift, cmRubberband) then
begin
if not FRubberbandMode then
RubberbandStart(AMapView, X, Y)