diff --git a/components/lazmapviewer/examples/plugin_demos/markereditor_demo/main.lfm b/components/lazmapviewer/examples/plugin_demos/markereditor_demo/main.lfm
index 02b461e4a..88648a78b 100644
--- a/components/lazmapviewer/examples/plugin_demos/markereditor_demo/main.lfm
+++ b/components/lazmapviewer/examples/plugin_demos/markereditor_demo/main.lfm
@@ -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
diff --git a/components/lazmapviewer/examples/plugin_demos/markereditor_demo/main.pas b/components/lazmapviewer/examples/plugin_demos/markereditor_demo/main.pas
index 80cddf620..3dd9c1ebc 100644
--- a/components/lazmapviewer/examples/plugin_demos/markereditor_demo/main.pas
+++ b/components/lazmapviewer/examples/plugin_demos/markereditor_demo/main.pas
@@ -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;
diff --git a/components/lazmapviewer/source/addons/plugins/markers/mvmarkerplugins.pas b/components/lazmapviewer/source/addons/plugins/markers/mvmarkerplugins.pas
index de4002e39..673ddce8d 100644
--- a/components/lazmapviewer/source/addons/plugins/markers/mvmarkerplugins.pas
+++ b/components/lazmapviewer/source/addons/plugins/markers/mvmarkerplugins.pas
@@ -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;
diff --git a/components/lazmapviewer/source/mvmapviewer.pas b/components/lazmapviewer/source/mvmapviewer.pas
index 1d8ae9838..a47dc0bf6 100644
--- a/components/lazmapviewer/source/mvmapviewer.pas
+++ b/components/lazmapviewer/source/mvmapviewer.pas
@@ -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