diff --git a/components/lazmapviewer/examples/plugin_demos/markereditor_demo/main.lfm b/components/lazmapviewer/examples/plugin_demos/markereditor_demo/main.lfm index 400d400c5..f562cbd45 100644 --- a/components/lazmapviewer/examples/plugin_demos/markereditor_demo/main.lfm +++ b/components/lazmapviewer/examples/plugin_demos/markereditor_demo/main.lfm @@ -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 diff --git a/components/lazmapviewer/examples/plugin_demos/markereditor_demo/main.pas b/components/lazmapviewer/examples/plugin_demos/markereditor_demo/main.pas index 1c6c4156f..69327b106 100644 --- a/components/lazmapviewer/examples/plugin_demos/markereditor_demo/main.pas +++ b/components/lazmapviewer/examples/plugin_demos/markereditor_demo/main.pas @@ -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); @@ -162,7 +164,7 @@ begin AddGPSMarker(RealPoint(43.6439500, -79.388400), 'CN Tower, Toronto'); AddMapMarker(RealPoint(21.2716900, -157.773980), 'Kahala Avenue, Honolulu'); AddMapMarker(RealPoint(22.2708100, 114.149790), 'The Peak, Hong Kong'); - AddMapMarker(RealPoint(52.5163890, 13.377778), 'Brandenburger Tor, Berlin'); + AddMapMarker(RealPoint(52.5163890, 13.377778), 'Brandenburger Tor, Berlin'); AddGPSTrack([RealPoint(-20,20), RealPoint(20, 0), RealPoint(-20,-20)]); AddMapTrack([RealPoint(20,20), RealPoint(-20,0), RealPoint(20,-20)]); @@ -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 diff --git a/components/lazmapviewer/source/addons/plugins/markers/mvmarkerplugins.pas b/components/lazmapviewer/source/addons/plugins/markers/mvmarkerplugins.pas index df5b03f50..742896a61 100644 --- a/components/lazmapviewer/source/addons/plugins/markers/mvmarkerplugins.pas +++ b/components/lazmapviewer/source/addons/plugins/markers/mvmarkerplugins.pas @@ -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 - exit; - end; + if not CanClick(AMapView, FOrigGPSPoint) then + exit; 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