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

LazMapViewer: Add rubberband selection to TMarkerEditorPlugin.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9698 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2025-03-23 14:06:17 +00:00
parent 6ef401c2e3
commit 8441d2546f
4 changed files with 179 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -10,7 +10,7 @@ object MainForm: TMainForm
OnCreate = FormCreate
object MapView: TMapView
Left = 0
Height = 442
Height = 423
Top = 0
Width = 833
Align = alClient
@ -33,13 +33,13 @@ object MainForm: TMainForm
end
object Panel1: TPanel
Left = 0
Height = 124
Top = 442
Height = 143
Top = 423
Width = 833
Align = alBottom
AutoSize = True
BevelOuter = bvNone
ClientHeight = 124
ClientHeight = 143
ClientWidth = 833
TabOrder = 1
object cgPointTypes: TCheckGroup
@ -116,9 +116,9 @@ object MainForm: TMainForm
AnchorSideBottom.Control = cbMultiSelect
AnchorSideBottom.Side = asrBottom
Left = 387
Height = 108
Height = 127
Top = 8
Width = 166
Width = 196
AutoFill = True
AutoSize = True
BorderSpacing.Right = 8
@ -132,14 +132,15 @@ object MainForm: TMainForm
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 88
ClientWidth = 162
ItemIndex = 0
ClientHeight = 107
ClientWidth = 192
ItemIndex = 1
Items.Strings = (
'Create new point'
'Add point to selection'
'Add shape to selection'
'Toggle selected point'
'Select by dragging rectangle'
)
TabOrder = 1
OnClick = rgClickModeClick
@ -148,7 +149,7 @@ object MainForm: TMainForm
AnchorSideLeft.Control = rgNewPointType
AnchorSideTop.Control = rgNewPointType
AnchorSideTop.Side = asrBottom
Left = 569
Left = 599
Height = 19
Top = 83
Width = 77
@ -160,7 +161,7 @@ object MainForm: TMainForm
AnchorSideLeft.Control = rgNewPointType
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = rgClickMode
Left = 685
Left = 715
Height = 25
Top = 8
Width = 109
@ -173,7 +174,7 @@ object MainForm: TMainForm
AnchorSideLeft.Control = btnDeleteSelection
AnchorSideTop.Control = btnDeleteSelection
AnchorSideTop.Side = asrBottom
Left = 685
Left = 715
Height = 25
Top = 33
Width = 111
@ -186,7 +187,7 @@ object MainForm: TMainForm
AnchorSideLeft.Control = btnDeleteSelection
AnchorSideTop.Control = btnConvertToTrack
AnchorSideTop.Side = asrBottom
Left = 685
Left = 715
Height = 25
Top = 58
Width = 107
@ -201,7 +202,7 @@ object MainForm: TMainForm
AnchorSideTop.Control = Panel1
AnchorSideBottom.Control = btnConvertToArea
AnchorSideBottom.Side = asrBottom
Left = 569
Left = 599
Height = 67
Top = 8
Width = 100

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

@ -196,7 +196,7 @@ begin
if cgPointTypes.Checked[Index] then
Include(pointTypes, TMvPointType(Index))
else
Exclude(pointtypes, TMvPointType(Index));
Exclude(pointTypes, TMvPointType(Index));
Plugin.PointTypes := pointTypes;
end;

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

@ -135,17 +135,30 @@ type
TMarkerStartDragEvent = procedure (AMapView: TMapView; var CanDrag: Boolean) of object;
TMarkerClickMode = (mcmNewPoint, mcmAddPointToSelection, mcmAddShapeToSelection, mcmToggleSelectedPoint);
TMarkerClickMode = (cmNewPoint, cmAddPointToSelection, cmAddShapeToSelection,
cmToggleSelectedPoint, cmRubberband);
TMarkerNewPointType = (nptGPSPoint, nptMapPoint);
TMarkerEditorPlugin = class(TMarkerClickPlugin)
private
const
DEFAULT_CLICKMODE = cmAddPointToSelection;
DEFAULT_RUBBERBAND_BORDERCOLOR = clGray;
DEFAULT_RUBBERBAND_FILLCOLOR = clWhite;
DEFAULT_RUBBERBAND_OPACITY = 0.55;
private
FClickMode: TMarkerClickMode;
FDragCursor: TCursor;
FDragging: Boolean;
FMultiSelect: Boolean;
FNewPointType: TMarkerNewPointType;
FRubberbandBorderColor: TColor;
FRubberbandFillColor: TColor;
FRubberbandOpacity: Single;
FRubberbandMode: Boolean;
FRubberbandStartPt: TPoint;
FRubberbandEndPt: TPoint;
FSelection: TGPSPointList;
FOrigSelection: array of TRealPoint; // Selection before dragging starts
FOnDrawPoint: TMarkerDrawPointEvent;
@ -153,9 +166,10 @@ type
FOnSelectionChange: TNotifyEvent;
FOnStartDrag: TMarkerStartDragEvent;
FOnEndDrag: TNotifyEvent;
function IsOpacityStored: Boolean;
procedure SetMultiSelect(AValue: Boolean);
protected
procedure AddToSelection(AMapView: TMapView; APoint: TGPSPoint);
procedure AddToSelection(AMapView: TMapView; APoint: TGPSPoint; AExtendSelection: Boolean);
procedure DeleteFromList(AMapView: TMapView; APoint: TGPSPoint);
procedure DoSelectionChange(AMapView: TMapView);
procedure DragStart(AMapView: TMapView);
@ -163,9 +177,14 @@ type
procedure DragEnd(AMapView: TMapView);
procedure DrawPoint(AMapView: TMapView; ADrawingEngine: TMvCustomDrawingEngine;
AGpsPoint: TGPSPoint; AScreenPoint: TPoint; AMarkerSize: Integer);
procedure DrawRubberband(AMapView: TMapView);
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 RubberbandRect: TRect;
procedure RubberbandStart(AMapView: TMapView; X, Y: Integer);
procedure RubberbandTo(AMapView: TMapView; X, Y: Integer);
procedure RubberbandEnd(AMapView: TMapView; X, Y: Integer);
procedure ToggleSelected(AMapView: TMapView; APoint: TGPSPoint);
protected
procedure AfterDrawObjects(AMapView: TMapView; var {%H-}Handled: Boolean); override;
@ -186,13 +205,17 @@ type
procedure MoveSelectionBy(AMapView: TMapView; dx, dy: Double);
procedure MoveSelectionBy(AMapView: TMapView; dx, dy: Integer);
function NewPoint(AMapView: TMapView; X, Y: Integer): TGPSPoint;
procedure SelectAllPointsOfShape(AMapView: TMapView; APoint: TGPSPoint);
procedure SelectAllPointsOfShape(AMapView: TMapView; APoint: TGPSPoint; AExtendSelection: Boolean);
procedure SelectInRubberband(AMapView: TMapView);
property Selection: TGPSPointList read FSelection;
published
property ClickMode: TMarkerClickMode read FClickMode write FClickMode default mcmAddPointToSelection;
property ClickMode: TMarkerClickMode read FClickMode write FClickMode default DEFAULT_CLICKMODE;
property DragCursor: TCursor read FDragCursor write FDragCursor default crSizeAll;
property MultiSelect: Boolean read FMultiSelect write SetMultiSelect 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 OnDrawPoint: TMarkerDrawPointEvent read FOnDrawPoint write FOnDrawPoint;
property OnEndDrag: TNotifyEvent read FOnEndDrag write FOnEndDrag;
property OnNewPoint: TMarkerNewPointEvent read FOnNewPoint write FOnNewPoint;
@ -440,7 +463,11 @@ end;
constructor TMarkerEditorPlugin.Create(AOwner: TComponent);
begin
inherited;
FClickMode := DEFAULT_CLICKMODE;
FDragCursor := crSizeAll;
FRubberbandBorderColor := DEFAULT_RUBBERBAND_BORDERCOLOR;
FRubberbandFillColor := DEFAULT_RUBBERBAND_FILLCOLOR;
FRubberbandOpacity := DEFAULT_RUBBERBAND_OPACITY;
FSelection := TGPSPointList.Create(false); // false = do not free objects
end;
@ -451,11 +478,11 @@ begin
end;
procedure TMarkerEditorPlugin.AddToSelection(AMapView: TMapView;
APoint: TGPSPoint);
APoint: TGPSPoint; AExtendSelection: Boolean);
var
idx: Integer;
begin
if FMultiSelect then
if AExtendSelection then
begin
idx := FSelection.IndexOf(APoint);
if idx > -1 then
@ -475,6 +502,8 @@ procedure TMarkerEditorPlugin.AfterDrawObjects(AMapView: TMapView;
begin
inherited;
DrawSelection(AMapView);
if FRubberbandMode then
DrawRubberband(AMapView);
end;
function TMarkerEditorPlugin.ConvertSelectedPointsToGPSArea(
@ -670,6 +699,32 @@ begin
);
end;
procedure TMarkerEditorPlugin.DrawRubberband(AMapView: TMapView);
var
DE: TMvCustomDrawingEngine;
R: TRect;
begin
DE := AMapView.DrawingEngine;
if FRubberbandFillColor = clNone then
DE.BrushStyle := bsClear
else
begin
DE.BrushColor := FRubberbandFillColor;
DE.BrushStyle := bsSolid;
end;
if FRubberbandBorderColor = clNone then
DE.PenStyle := psClear
else
begin
DE.PenColor := FRubberbandBorderColor;
DE.PenStyle := psSolid;
DE.PenWidth := 1;
end;
DE.Opacity := FRubberbandOpacity;
R := RubberbandRect;
DE.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
end;
procedure TMarkerEditorPlugin.DrawSelection(AMapView: TMapView);
const
MARKER_SIZE = 5;
@ -821,6 +876,11 @@ begin
AIndex := -1;
end;
function TMarkerEditorPlugin.IsOpacityStored: Boolean;
begin
Result := FRubberbandOpacity <> DEFAULT_RUBBERBAND_OPACITY;
end;
{ Moves the selection by the given amound of pixels in x and y direction. }
procedure TMarkerEditorPlugin.MoveSelectionBy(AMapView: TMapView; dx, dy: Integer);
var
@ -869,11 +929,11 @@ begin
if FMouseDownOnMarker then
begin
case FClickMode of
mcmAddPointToSelection:
AddToSelection(AMapView, FOrigGPSPoint);
mcmAddShapeToSelection:
SelectAllPointsOfShape(AMapView, FOrigGPSPoint);
mcmToggleSelectedPoint:
cmAddPointToSelection:
AddToSelection(AMapView, FOrigGPSPoint, FMultiSelect);
cmAddShapeToSelection:
SelectAllPointsOfShape(AMapView, FOrigGPSPoint, FMultiSelect);
cmToggleSelectedPoint:
ToggleSelected(AMapView, FOrigGPSPoint);
end;
Update;
@ -881,11 +941,14 @@ begin
end else
begin
case FClickMode of
mcmNewPoint:
cmNewPoint:
begin
FOrigGPSPoint := NewPoint(AMapView, X, Y);
AddToSelection(AMapView, FOrigGPSPoint);
AddToSelection(AMapView, FOrigGPSPoint, FMultiSelect);
Handled := true;
end;
cmRubberband:
;
else
FSelection.Clear;
end;
@ -917,6 +980,14 @@ begin
end;
DragTo(AMapView, X, Y);
Handled := true;
end else
if not FDragging and (FClickMode = cmRubberband) and (Shift = AShift) then
begin
if not FRubberbandMode then
RubberbandStart(AMapView, X, Y)
else
RubberbandTo(AMapView, X, Y);
Handled := true;
end;
end;
@ -927,6 +998,8 @@ begin
inherited;
if FDragging then
DragEnd(AMapView);
if FRubberbandMode then
RubberbandEnd(AMapView, X, Y);
end;
function TMarkerEditorPlugin.NewPoint(AMapView: TMapView;
@ -962,8 +1035,36 @@ begin
FOnNewPoint(AMapView, Result);
end;
procedure TMarkerEditorPlugin.RubberbandEnd(AMapView: TMapView; X, Y: Integer);
begin
FRubberbandMode := false;
FRubberbandEndPt := Point(X, Y);
SelectInRubberband(AMapview);
Update;
end;
function TMarkerEditorPlugin.RubberbandRect: TRect;
begin
Result.TopLeft := FRubberBandStartPt;
Result.BottomRight := FRubberbandEndPt;
Result.NormalizeRect;
end;
procedure TMarkerEditorPlugin.RubberbandStart(AMapView: TMapView; X, Y: Integer);
begin
FRubberbandMode := true;
FRubberbandStartPt := Point(X, Y);
FRubberbandEndPt := Point(X, Y);
end;
procedure TMarkerEditorPlugin.RubberbandTo(AMapView: TMapView; X, Y: Integer);
begin
FRubberbandEndPt := Point(X, Y);
Update;
end;
procedure TMarkerEditorPlugin.SelectAllPointsOfShape(AMapView: TMapView;
APoint: TGPSPoint);
APoint: TGPSPoint; AExtendSelection: Boolean);
var
obj: TGPSObj = nil;
collection: TMapCollectionBase = nil;
@ -975,19 +1076,22 @@ var
procedure Finished;
begin
AddToSelection(AMapView, APoint); // Mark APoint as being focused
AddToSelection(AMapView, APoint, true); // Mark APoint as being focused
Update;
DoSelectionChange(AMapView);
end;
begin
if not AExtendSelection then
FSelection.Clear;
// Find point in gpsObj-type of containers
FindContainerOfPoint(AMapView, APoint, obj, idx);
// Is is a point of interest?
if obj is TGPSObjectList then
begin
item := TGPSObjectList(obj).Items[idx];
AddToSelection(AMapView, TGPSPoint(item));
AddToSelection(AMapView, TGPSPoint(item), true);
Finished;
exit;
end else
@ -998,7 +1102,7 @@ begin
for i := 0 to gpsPolyLine.Points.Count-1 do
begin
item := TGPSPoint(gpsPolyLine.Points[i]);
AddToSelection(AMapView, TGPSPoint(item));
AddToSelection(AMapView, TGPSPoint(item), true);
end;
Finished;
exit;
@ -1009,27 +1113,46 @@ begin
if collection is TMapPointsOfInterest then
begin
p := collection.Items[idx] as TMapPoint;
AddToSelection(AMapView, TGPSPoint(p.GPSObj));
AddToSelection(AMapView, TGPSPoint(p.GPSObj), true);
end else
if collection <> nil then
begin
for i := 0 to collection.Count-1 do
begin
p := collection.Items[i] as TMapPoint;
AddToSelection(AMapView, TGPSPoint(p.GPSObj));
AddToSelection(AMapView, TGPSPoint(p.GPSObj), true);
end;
end;
Finished;
end;
procedure TMarkerEditorPlugin.SelectInRubberband(AMapView: TMapView);
var
area: TRealArea;
R: TRect;
pts: TGPSObjArray;
i: Integer;
begin
if not FMultiSelect then
FSelection.Clear;
R := RubberbandRect;
area.TopLeft := AMapView.ScreenToLatLon(R.TopLeft);
area.BottomRight := AMapView.ScreenToLatLon(R.BottomRight);
pts := AMapView.VisiblePointsInArea(area, PointTypes);
for i := 0 to High(pts) do
AddToSelection(AMapView, TGPSPoint(pts[i]), true);
Update;
end;
procedure TMarkerEditorPlugin.SetMultiSelect(AValue: Boolean);
begin
if FMultiSelect = AValue then exit;
FMultiSelect := AValue;
if not FMultiSelect then
if (not FMultiSelect) then
begin
FSelection.Clear;
FSelection.Add(FOrigGPSPoint);
if (FOrigGPSPoint <> nil) then
FSelection.Add(FOrigGPSPoint);
end;
Update;
end;

31
components/lazmapviewer/source/mvmapviewer.pas
View File

@ -725,6 +725,8 @@ type
AClass: TGPSObjClass = nil): TGPSObjArray;
function VisiblePointsAtScreenPt(X, Y: Integer; ATolerance: Integer = -1;
APointTypes: TMvPointTypes = ptAll): TGPSObjArray;
function VisiblePointsInArea(Area: TRealArea;
APointTypes: TMvPointTypes = ptAll): TGPSObjArray;
procedure SaveToFile(AClass: TRasterImageClass; const AFileName: String);
function SaveToImage(AClass: TRasterImageClass): TRasterImage;
procedure SaveToStream(AClass: TRasterImageClass; AStream: TStream);
@ -1156,8 +1158,7 @@ begin
FPoints.Assign(AValue);
end;
procedure TMapArea.DrawArea(Sender: TObject; AGPSObj: TGPSObj; AArea: TRealArea
);
procedure TMapArea.DrawArea(Sender: TObject; AGPSObj: TGPSObj; AArea: TRealArea);
begin
if Assigned(FOnDrawArea) then
FOnDrawArea(Sender, (Collection as TMapAreas).GetView.DrawingEngine, Self);
@ -4094,16 +4095,9 @@ end;
function TMapView.VisiblePointsAtScreenPt(X, Y: Integer; ATolerance: Integer = -1;
APointTypes: TMvPointTypes = ptAll): TGPSObjArray;
const
BLOCK_SIZE = 100;
var
area: TRealArea;
i, j, nObj: Integer;
gpsList: TGPSObjList;
obj: TGPSObj;
begin
Result := nil;
if ATolerance = -1 then
ATolerance := POINT_DELTA;
@ -4111,12 +4105,25 @@ begin
area.TopLeft := ScreenToLatLon(Point(X - ATolerance, Y - ATolerance));
area.BottomRight := ScreenToLatLon(Point(X + ATolerance, Y + ATolerance));
nObj := 0;
Result := VisiblePointsInArea(area, APointTypes);
end;
function TMapView.VisiblePointsInArea(Area: TRealArea;
APointTypes: TMvPointTypes = ptAll): TGPSObjArray;
const
BLOCK_SIZE = 100;
var
i, j, nObj: Integer;
gpsList: TGPSObjList;
obj: TGPSObj;
begin
Result := nil;
nObj := 0;
if ([ptGPSPointOfInterest, ptGPSTrackPoint, ptGPSAreaPoint] * APointTypes <> []) then
for j := 0 to 9 do
begin
gpsList := FGPSItems[j].GetPointsInArea(area, APointTypes);
gpsList := FGPSItems[j].GetPointsInArea(Area, APointTypes);
try
if Assigned(gpsList) then
for i := 0 to gpsList.Count-1 do
@ -4138,7 +4145,7 @@ begin
if [ptMapPointOfInterest, ptMapTrackPoint, ptMapAreaPoint] * APointTypes <> [] then
for j := 0 to Layers.Count-1 do
begin
gpsList := Layers[j].GetPointsInArea(area, APointTypes);
gpsList := Layers[j].GetPointsInArea(Area, APointTypes);
try
if Assigned(gpsList) then
for i := 0 to gpsList.Count-1 do