d334b73843
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9614 8e941d3f-bd1b-0410-a28a-d453659cc2b4
1036 lines
32 KiB
ObjectPascal
1036 lines
32 KiB
ObjectPascal
{
|
|
mvAreaSelectionPlugin
|
|
|
|
Copyright (C) 2025 Ekkehard Domning (www.domis.de)
|
|
|
|
License: modified LGPL with linking exception (like RTL, FCL and LCL)
|
|
|
|
See the file COPYING.modifiedLGPL.txt, included in the Lazarus distribution,
|
|
for details about the license.
|
|
|
|
This plugin allows the user to select an area on the map.
|
|
|
|
The Plugin can be used only on *one* MapView, so it is mandatory to assign a
|
|
MapView to the MapView property.
|
|
|
|
The plugin is able to deal with the Cyclic property of the MapView. This allows
|
|
the selection of "WrapAround"-Areas, which are changing the date border.
|
|
Those areas have the property that the BottomRight.Lon is *smaller* than the
|
|
TopLeft.Lon!
|
|
|
|
Example:
|
|
The Area
|
|
TopLeft.Lon = 13.4 (Berlin)
|
|
BottomRight.Lon = 0.0 (London)
|
|
wraps around the Date-Border, while the Area
|
|
TopLeft.Lon = 0.0 (London)
|
|
BottomRight.Lon = 13.4 (Berlin)
|
|
does not!
|
|
|
|
Two events are implemented. One is called if the selection of a new area is in
|
|
progress, the other when the selection is finished.
|
|
|
|
The user can change the rectangle by dragging some anchors with the mouse.
|
|
|
|
Those anchors are the 4 lines, the 4 corners and a small area around the top line.
|
|
The method of changing is indicated by the mouse pointer.
|
|
|
|
Assigning a new SelectedArea while changing is not supported
|
|
}
|
|
unit mvAreaSelectionPlugin;
|
|
|
|
{$mode ObjFPC}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Controls, Types, Math, Graphics, Contnrs,
|
|
mvPluginCommon, mvPlugins, mvMapViewer, mvTypes, mvGeoMath, mvDrawingEngine;
|
|
|
|
type
|
|
{ class TMouseHitItem
|
|
A helper class to hold a single detectable Item, Like corner, edge, etc.
|
|
Not intended to be used outside this unit.
|
|
}
|
|
TMouseHitItem = class(TObject)
|
|
private
|
|
FTag : Integer;
|
|
FZOrder : Integer;
|
|
FActiveRect : TRect;
|
|
FCursor : TCursor;
|
|
FItemHit : Boolean;
|
|
FMouseDownFlag : Boolean;
|
|
FOrgX, FOrgY : Integer;
|
|
FMouseDownX, FMouseDownY : Integer;
|
|
FMouseDeltaX, FMouseDeltaY : Integer;
|
|
public
|
|
constructor Create;
|
|
constructor Create(const AActiveRect : TRect;
|
|
const AOrgX : Integer;
|
|
const AOrgY : Integer;
|
|
const AZOrder : Integer = 0;
|
|
const ACursor : TCursor = crSize;
|
|
const ATag : Integer = 0);
|
|
procedure OnMouseDown(Shift: TShiftState; X, Y: Integer);
|
|
procedure OnMouseMove(Shift: TShiftState; X, Y: Integer);
|
|
procedure OnMouseUp(Shift: TShiftState; X, Y: Integer);
|
|
|
|
property Tag : Integer read FTag write FTag;
|
|
property ZOrder : Integer read FZOrder write FZOrder;
|
|
property ActiveRect : TRect read FActiveRect write FActiveRect;
|
|
property Cursor : TCursor read FCursor write FCursor;
|
|
property OrgX : Integer read FOrgX;
|
|
property OrgY : Integer read FOrgY;
|
|
property ItemHit : Boolean read FItemHit;
|
|
property MouseDownFlag : Boolean read FMouseDownFlag write FMouseDownFlag;
|
|
property MouseDownX : Integer read FMouseDownX;
|
|
property MouseDownY : Integer read FMouseDownY;
|
|
property MouseDeltaX : Integer read FMouseDeltaX;
|
|
property MouseDeltaY : Integer read FMouseDeltaY;
|
|
end;
|
|
|
|
type
|
|
TSelectedAreaChangingEvent = procedure (Sender : TObject; ANewArea : TRealArea; var Allow : Boolean) of Object;
|
|
|
|
{ TAreaSelectionPlugin }
|
|
TAreaSelectionPlugin = class(TMvDrawPlugin)
|
|
private
|
|
const
|
|
DEFAULT_PEN_COLOR = clNavy;
|
|
DEFAULT_PEN_STYLE = psSolid;
|
|
DEFAULT_PEN_WIDTH = 3;
|
|
DEFAULT_SENSITIVE_AREA_INFLATION = 2; // this increases the pixels of the sensitive items
|
|
private
|
|
FMouseHitItems : TObjectList; // The list with the clickable items
|
|
FMouseButton : TMouseButton;
|
|
FShifterXInverseMode : Boolean; // Two Flags to ease the user interface for the flat and cylindrical world
|
|
FShifterYInverseMode : Boolean;
|
|
FSelectedArea : TRealArea;
|
|
FLastMouseMoveHandled : Boolean;
|
|
FPenColor : TColor;
|
|
FPenStyle : TPenStyle;
|
|
FPenWidth : Integer;
|
|
FAreaInflation : Integer;
|
|
FMouseMapCoords : TRealPoint;
|
|
FSelectedAreaChangedEvent : TNotifyEvent;
|
|
FSelectedAreaChangingEvent : TSelectedAreaChangingEvent;
|
|
function GetCurrentItem : TMouseHitItem;
|
|
function GetItemsCount: Integer;
|
|
function GetItems(AIndex : Integer) : TMouseHitItem;
|
|
procedure SetMouseButton(AValue: TMouseButton);
|
|
procedure SetPenColor(Value : TColor);
|
|
procedure SetPenWidth(Value : Integer);
|
|
procedure SetPenStyle(Value : TPenStyle);
|
|
procedure SetSensitiveAreaInflation(Value : Integer);
|
|
procedure SetSelectedArea(Value : TRealArea);
|
|
protected
|
|
procedure AddSelectionArea(const ARect: TRect; const AInflate: Integer);
|
|
procedure AddSelectionAreaEx(const ARect: TRect; const ARectParts: array of Integer;
|
|
const AInflate: Integer);
|
|
procedure AfterPaint(AMapView: TMapView; var Handled: Boolean); override;
|
|
procedure MouseMove(AMapView: TMapView; AShift: TShiftState; X,Y: Integer;
|
|
var Handled: Boolean); override;
|
|
procedure MouseUp(AMapView: TMapView; Button: TMouseButton; Shift: TShiftState;
|
|
X,Y: Integer; var Handled: Boolean); override;
|
|
procedure MouseDown(AMapView: TMapView; Button: TMouseButton; Shift: TShiftState;
|
|
X,Y: Integer; var Handled: Boolean); override;
|
|
procedure CenterMove(AMapView: TMapView; var Handled: Boolean); override;
|
|
procedure ZoomChange(AMapView: TMapView; var Handled: Boolean); override;
|
|
procedure Resize(AMapView: TMapView; var Handled: Boolean); override;
|
|
|
|
property ItemsCount : Integer read GetItemsCount;
|
|
property Items[AIndex : Integer] : TMouseHitItem read GetItems;
|
|
{ property CurrentItem returns either the Item where the Mouse is down or the one where the mouse is hovering above }
|
|
property CurrentItem : TMouseHitItem read GetCurrentItem;
|
|
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy;override;
|
|
{ procedure Clear the list of all items. Usually called in MouseUp and prior the rebuilding of a new setup }
|
|
procedure Clear;
|
|
{ procedure SetupRectShifter creates the mouse shifting items, must be called if the display changes
|
|
needed e.g.if the size of the MapView is altered}
|
|
procedure SetupRectShifter;
|
|
|
|
property SelectedArea : TRealArea read FSelectedArea write SetSelectedArea;
|
|
published
|
|
property MouseButton: TMouseButton read FMouseButton write SetMouseButton default mbLeft;
|
|
property SensitiveAreaInflation: Integer read FAreaInflation write SetSensitiveAreaInflation default DEFAULT_SENSITIVE_AREA_INFLATION;
|
|
property OnSelectedAreaChanged: TNotifyEvent read FSelectedAreaChangedEvent write FSelectedAreaChangedEvent;
|
|
property OnSelectedAreaChanging: TSelectedAreaChangingEvent read FSelectedAreaChangingEvent write FSelectedAreaChangingEvent;
|
|
|
|
property Pen;
|
|
end;
|
|
|
|
implementation
|
|
|
|
const
|
|
tagRectArea = 1;
|
|
tagRectLeft = 2;
|
|
tagRectTop = 3;
|
|
tagRectRight = 4;
|
|
tagRectBottom = 5;
|
|
tagRectTopLeft = 6;
|
|
tagRectTopRight = 7;
|
|
tagRectBottomRight = 8;
|
|
tagRectBottomLeft = 9;
|
|
|
|
{function RealAreaWidth calculates the width of an area on earth.
|
|
if the BottomRight.Lon is smaller than the TopLeft.Lon, the
|
|
area is treated as wrapping around the date border}
|
|
function RealAreaWidth(const ARealArea : TRealArea) : Double;
|
|
begin
|
|
Result := ARealArea.BottomRight.Lon-ARealArea.TopLeft.Lon;
|
|
if ARealArea.BottomRight.Lon < ARealArea.TopLeft.Lon then
|
|
Result := Result + 360.0;
|
|
end;
|
|
|
|
procedure RealAreaNormed(var ARealArea : TRealArea);
|
|
begin
|
|
ARealArea.TopLeft.Lat := EnsureRange(ARealArea.TopLeft.Lat, -90, 90);
|
|
ARealArea.TopLeft.Lon := EnsureRange(ARealArea.TopLeft.Lon, -180, 180);
|
|
ARealArea.BottomRight.Lat := EnsureRange(ARealArea.BottomRight.Lat, -90, 90);
|
|
ARealArea.BottomRight.Lon := EnsureRange(ArealArea.BottomRight.Lon, -180, 180);
|
|
{
|
|
if ARealArea.TopLeft.Lat > 90.0 then
|
|
ARealArea.TopLeft.Lat := 90.0
|
|
else if ARealArea.TopLeft.Lat < -90.0 then
|
|
ARealArea.TopLeft.Lat := -90.0;
|
|
if ARealArea.TopLeft.Lon < -180.0 then
|
|
ARealArea.TopLeft.Lon := -180.0
|
|
else if ARealArea.TopLeft.Lon > 180.0 then
|
|
ARealArea.TopLeft.Lon := 180.0;
|
|
if ARealArea.BottomRight.Lat > 90.0 then
|
|
ARealArea.BottomRight.Lat := 90.0
|
|
else if ARealArea.BottomRight.Lat < -90.0 then
|
|
ARealArea.BottomRight.Lat := -90.0;
|
|
if ARealArea.BottomRight.Lon < -180.0 then
|
|
ARealArea.BottomRight.Lon := -180.0
|
|
else if ARealArea.BottomRight.Lon > 180.0 then
|
|
ARealArea.BottomRight.Lon := 180.0;
|
|
}
|
|
end;
|
|
|
|
{ function IsInRectangle returns true, if the passed X and Y coords are inside the rectangle
|
|
Parameter:
|
|
ARect : The rectangle to test
|
|
AX, AY : The coords to test
|
|
AInflate : The amount of inflating the rectangle
|
|
Remarks: The function works different from the definition in uLazQuadTreeGeometry.
|
|
The rectangle here is treated having the right and bottom border as part of the
|
|
rectangle! This is needed, because the right and bottom border must be hit for
|
|
resizing.
|
|
}
|
|
function IsInRectangle(const ARect : TRect; const AX, AY : Integer; const AInflate : Integer = 0): Boolean;
|
|
var
|
|
R: TRect;
|
|
begin
|
|
R := ARect;
|
|
if AInflate > 0 then
|
|
InflateRect(R, AInflate, AInflate);
|
|
Result := PtInRect(R, Point(AX, AY));
|
|
end;
|
|
|
|
{ TMouseHitItem }
|
|
|
|
procedure TMouseHitItem.OnMouseDown(Shift: TShiftState; X,
|
|
Y: Integer);
|
|
begin
|
|
Unused(Shift);
|
|
if IsInRectangle(FActiveRect, X, Y, 0) then
|
|
begin
|
|
FMouseDownFlag := True;
|
|
FMouseDeltaX := 0;
|
|
FMouseDeltaY := 0;
|
|
FMouseDownX := X;
|
|
FMouseDownY := Y;
|
|
end;
|
|
end;
|
|
|
|
procedure TMouseHitItem.OnMouseMove(Shift: TShiftState; X,
|
|
Y: Integer);
|
|
begin
|
|
Unused(Shift);
|
|
if FMouseDownFlag then
|
|
begin
|
|
FMouseDeltaX := X-FMouseDownX;
|
|
FMouseDeltaY := Y-FMouseDownY;
|
|
end
|
|
else
|
|
begin
|
|
FMouseDeltaX := 0;
|
|
FMouseDeltaY := 0;
|
|
FItemHit := IsInRectangle(FActiveRect, X, Y, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TMouseHitItem.OnMouseUp(Shift: TShiftState; X,
|
|
Y: Integer);
|
|
begin
|
|
Unused(Shift);
|
|
if FMouseDownFlag then
|
|
begin
|
|
FMouseDeltaX := X-FMouseDownX;
|
|
FMouseDeltaY := Y-FMouseDownY;
|
|
FMouseDownFlag := False;
|
|
end
|
|
else
|
|
begin
|
|
FMouseDeltaX := 0;
|
|
FMouseDeltaY := 0;
|
|
end;
|
|
end;
|
|
|
|
constructor TMouseHitItem.Create;
|
|
begin
|
|
inherited Create;
|
|
end;
|
|
|
|
constructor TMouseHitItem.Create(const AActiveRect: TRect;
|
|
const AOrgX: Integer; const AOrgY: Integer; const AZOrder: Integer;
|
|
const ACursor: TCursor; const ATag: Integer);
|
|
begin
|
|
Create();
|
|
FActiveRect := AActiveRect;
|
|
FOrgX := AOrgX;
|
|
FOrgY := AOrgY;
|
|
FZOrder := AZOrder;
|
|
FCursor := ACursor;
|
|
FTag := ATag;
|
|
end;
|
|
|
|
|
|
{ TAreaSelectionPlugin }
|
|
|
|
constructor TAreaSelectionPlugin.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FMouseHitItems := TObjectList.Create(True);
|
|
FSelectedArea.Init(-100,50,100,-50);
|
|
// FSelectedArea.Init(0,0,0,0);
|
|
Pen.Color := DEFAULT_PEN_COLOR;
|
|
Pen.Width := DEFAULT_PEN_WIDTH;
|
|
Pen.Style := DEFAULT_PEN_STYLE;
|
|
FAreaInflation := DEFAULT_SENSITIVE_AREA_INFLATION;
|
|
end;
|
|
|
|
destructor TAreaSelectionPlugin.Destroy;
|
|
begin
|
|
FreeAndNil(FMouseHitItems);
|
|
inherited;
|
|
end;
|
|
|
|
function TAreaSelectionPlugin.GetCurrentItem: TMouseHitItem;
|
|
var
|
|
i : Integer;
|
|
lItem : TMouseHitItem;
|
|
begin
|
|
Result := Nil;
|
|
for i := 0 to ItemsCount-1 do
|
|
begin
|
|
lItem := TMouseHitItem(FMouseHitItems[i]);
|
|
if lItem.FMouseDownFlag then
|
|
begin
|
|
if (not Assigned(Result)) or
|
|
(Result.ZOrder < lItem.ZOrder) then
|
|
Result := lItem;
|
|
end;
|
|
end;
|
|
if Assigned(Result) then Exit;
|
|
for i := 0 to ItemsCount-1 do
|
|
begin
|
|
lItem := TMouseHitItem(FMouseHitItems[i]);
|
|
if lItem.ItemHit then
|
|
begin
|
|
if (not Assigned(Result)) or
|
|
(Result.ZOrder < lItem.ZOrder) then
|
|
Result := lItem;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TAreaSelectionPlugin.GetItemsCount: Integer;
|
|
begin
|
|
Result := FMouseHitItems.Count;
|
|
end;
|
|
|
|
function TAreaSelectionPlugin.GetItems(AIndex: Integer): TMouseHitItem;
|
|
begin
|
|
Result := TMouseHitItem(FMouseHitItems[AIndex]);
|
|
end;
|
|
|
|
procedure TAreaSelectionPlugin.SetMouseButton(AValue: TMouseButton);
|
|
begin
|
|
if FMouseButton=AValue then Exit;
|
|
FMouseButton:=AValue;
|
|
end;
|
|
|
|
procedure TAreaSelectionPlugin.SetPenColor(Value: TColor);
|
|
begin
|
|
if FPenColor <> Value then
|
|
begin
|
|
FPenColor := Value;
|
|
if Assigned(MapView) then
|
|
MapView.Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TAreaSelectionPlugin.SetPenWidth(Value: Integer);
|
|
begin
|
|
if FPenWidth <> Value then
|
|
begin
|
|
FPenWidth := Value;
|
|
if Assigned(MapView) then
|
|
MapView.Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TAreaSelectionPlugin.SetPenStyle(Value: TPenStyle);
|
|
begin
|
|
if FPenStyle <> Value then
|
|
begin
|
|
FPenStyle := Value;
|
|
if Assigned(MapView) then
|
|
MapView.Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TAreaSelectionPlugin.SetSensitiveAreaInflation(Value: Integer);
|
|
begin
|
|
if FAreaInflation <> Value then
|
|
begin
|
|
FAreaInflation := Value;
|
|
if Assigned(MapView) then
|
|
MapView.Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TAreaSelectionPlugin.SetSelectedArea(Value: TRealArea);
|
|
begin
|
|
if not FSelectedArea.Equal(Value) then
|
|
begin
|
|
FSelectedArea.Init(Value.TopLeft, Value.BottomRight);
|
|
MapView.Invalidate;
|
|
SetupRectShifter;
|
|
end;
|
|
end;
|
|
|
|
procedure TAreaSelectionPlugin.Clear;
|
|
begin
|
|
FMouseHitItems.Clear;
|
|
end;
|
|
|
|
procedure TAreaSelectionPlugin.AddSelectionArea(const ARect: TRect;
|
|
const AInflate: Integer);
|
|
begin
|
|
AddSelectionAreaEx(ARect,
|
|
[tagRectArea, tagRectLeft, tagRectTop, tagRectRight, tagRectBottom,
|
|
tagRectTopLeft, tagRectTopRight, tagRectBottomRight, tagRectBottomLeft],
|
|
AInflate);
|
|
end;
|
|
|
|
procedure TAreaSelectionPlugin.AddSelectionAreaEx(const ARect: TRect;
|
|
const ARectParts: array of Integer; const AInflate: Integer);
|
|
var
|
|
lMaxExtentRect : TRect;
|
|
lRect : TRect;
|
|
i : Integer;
|
|
llr : TRect;
|
|
lItem : TMouseHitItem = Nil;
|
|
begin
|
|
lMaxExtentRect.Left := 0;
|
|
lMaxExtentRect.Top := 0;
|
|
lMaxExtentRect.Right := MapView.Width;
|
|
lMaxExtentRect.Bottom := MapView.Height;
|
|
lRect := ARect;
|
|
if ARect.Left < lMaxExtentRect.Left then
|
|
lRect.Left := lMaxExtentRect.Left
|
|
else if ARect.Left > lMaxExtentRect.Right then
|
|
lRect.Left := lMaxExtentRect.Right;
|
|
if ARect.Right < lMaxExtentRect.Left then
|
|
lRect.Right := lMaxExtentRect.Left
|
|
else if ARect.Right > lMaxExtentRect.Right then
|
|
lRect.Right := lMaxExtentRect.Right;
|
|
if ARect.Top < lMaxExtentRect.Top then
|
|
lRect.Top := lMaxExtentRect.Top
|
|
else if ARect.Top > lMaxExtentRect.Bottom then
|
|
lRect.Top := lMaxExtentRect.Bottom;
|
|
if ARect.Bottom < lMaxExtentRect.Top then
|
|
lRect.Bottom := lMaxExtentRect.Top
|
|
else if ARect.Bottom > lMaxExtentRect.Bottom then
|
|
lRect.Bottom := lMaxExtentRect.Bottom;
|
|
|
|
for i := 0 to High(ARectParts) do
|
|
begin
|
|
case ARectParts[i] of
|
|
tagRectArea :
|
|
begin
|
|
llr.Left:=lRect.Left;
|
|
llr.Top:=lRect.Top-3*AInflate;
|
|
llr.Right:=lRect.Right;
|
|
llr.Bottom:=lRect.Top+3*AInflate;
|
|
lItem := TMouseHitItem.Create(llr,ARect.Left,ARect.Top,0,crSize,
|
|
tagRectArea);
|
|
end;
|
|
tagRectLeft :
|
|
begin
|
|
// Left Border
|
|
if (ARect.Left > lMaxExtentRect.Left-(2*AInflate)) and
|
|
(ARect.Left < lMaxExtentRect.Right+(2*AInflate)) then
|
|
begin
|
|
llr.Left:=ARect.Left-AInflate;
|
|
llr.Top:=lRect.Top;
|
|
llr.Right:=ARect.Left+AInflate;
|
|
llr.Bottom:=lRect.Bottom;
|
|
lItem := TMouseHitItem.Create(llr,ARect.Left,ARect.Top,1,crSizeWE,
|
|
tagRectLeft);
|
|
end;
|
|
end;
|
|
tagRectTop :
|
|
begin
|
|
// Top Border
|
|
if (ARect.Top > lMaxExtentRect.Top-(2*AInflate)) and
|
|
(ARect.Top < lMaxExtentRect.Bottom-(2*AInflate)) then
|
|
begin
|
|
llr.Left:=lRect.Left;
|
|
llr.Top:=ARect.Top-AInflate;
|
|
llr.Right:=lRect.Right;
|
|
llr.Bottom:=ARect.Top+AInflate;
|
|
lItem := TMouseHitItem.Create(llr,ARect.Left,ARect.Top,1,crSizeNS,
|
|
tagRectTop);
|
|
end;
|
|
end;
|
|
tagRectRight :
|
|
begin
|
|
// Right Border
|
|
if (ARect.Right > lMaxExtentRect.Left-(2*AInflate)) and
|
|
(ARect.Right < lMaxExtentRect.Right+(2*AInflate)) then
|
|
begin
|
|
llr.Left:=ARect.Right-AInflate;
|
|
llr.Top:=lRect.Top;
|
|
llr.Right:=ARect.Right+AInflate;
|
|
llr.Bottom:=lRect.Bottom;
|
|
lItem := TMouseHitItem.Create(llr,ARect.Right,ARect.Top,1,crSizeWE,
|
|
tagRectRight);
|
|
end;
|
|
end;
|
|
tagRectBottom :
|
|
begin
|
|
// Bottom border
|
|
if (ARect.Bottom > lMaxExtentRect.Top-(2*AInflate)) and
|
|
(ARect.Bottom < lMaxExtentRect.Bottom-(2*AInflate)) then
|
|
begin
|
|
llr.Left:=lRect.Left;
|
|
llr.Top:=ARect.Bottom-AInflate;
|
|
llr.Right:=lRect.Right;
|
|
llr.Bottom:=ARect.Bottom+AInflate;
|
|
lItem := TMouseHitItem.Create(llr,ARect.Left,ARect.Bottom,1,crSizeNS,
|
|
tagRectBottom);
|
|
end;
|
|
end;
|
|
tagRectTopLeft :
|
|
begin
|
|
// Northwest edge
|
|
if (ARect.Left > lMaxExtentRect.Left-(2*AInflate)) and
|
|
(ARect.Left < lMaxExtentRect.Right+(2*AInflate)) and
|
|
(ARect.Top > lMaxExtentRect.Top-(2*AInflate)) and
|
|
(ARect.Top < lMaxExtentRect.Bottom-(2*AInflate)) then
|
|
begin
|
|
llr.Left := ARect.Left;
|
|
llr.Top := ARect.Top;
|
|
llr.Right := ARect.Left;
|
|
llr.Bottom := ARect.Top;
|
|
llr.Inflate(AInflate,AInflate);
|
|
lItem := TMouseHitItem.Create(llr,ARect.Left,ARect.Top,2,crSizeNWSE,
|
|
tagRectTopLeft);
|
|
end;
|
|
end;
|
|
tagRectTopRight :
|
|
begin
|
|
// NorthEast edge
|
|
if (ARect.Right > lMaxExtentRect.Left-(2*AInflate)) and
|
|
(ARect.Right < lMaxExtentRect.Right+(2*AInflate)) and
|
|
(ARect.Top > lMaxExtentRect.Top-(2*AInflate)) and
|
|
(ARect.Top < lMaxExtentRect.Bottom-(2*AInflate)) then
|
|
begin
|
|
llr.Left := ARect.Right;
|
|
llr.Top := ARect.Top;
|
|
llr.Right := ARect.Right;
|
|
llr.Bottom := ARect.Top;
|
|
llr.Inflate(AInflate,AInflate);
|
|
lItem := TMouseHitItem.Create(llr,ARect.Right,ARect.Top,2,crSizeNESW,
|
|
tagRectTopRight);
|
|
end;
|
|
end;
|
|
tagRectBottomRight :
|
|
begin
|
|
// SouthEast edge
|
|
if (ARect.Right > lMaxExtentRect.Left-(2*AInflate)) and
|
|
(ARect.Right < lMaxExtentRect.Right+(2*AInflate)) and
|
|
(ARect.Bottom > lMaxExtentRect.Top-(2*AInflate)) and
|
|
(ARect.Bottom < lMaxExtentRect.Bottom-(2*AInflate)) then
|
|
begin
|
|
llr.Left := ARect.Right;
|
|
llr.Top := ARect.Bottom;
|
|
llr.Right := ARect.Right;
|
|
llr.Bottom := ARect.Bottom;
|
|
llr.Inflate(AInflate,AInflate);
|
|
lItem := TMouseHitItem.Create(llr,ARect.Right,ARect.Bottom,2,crSizeNWSE,
|
|
tagRectBottomRight);
|
|
end;
|
|
end;
|
|
tagRectBottomLeft :
|
|
begin
|
|
// SouthWest edge
|
|
if (ARect.Left > lMaxExtentRect.Left-(2*AInflate)) and
|
|
(ARect.Left < lMaxExtentRect.Right+(2*AInflate)) and
|
|
(ARect.Bottom > lMaxExtentRect.Top-(2*AInflate)) and
|
|
(ARect.Bottom < lMaxExtentRect.Bottom-(2*AInflate)) then
|
|
begin
|
|
llr.Left := ARect.Left;
|
|
llr.Top := ARect.Bottom;
|
|
llr.Right := ARect.Left;
|
|
llr.Bottom := ARect.Bottom;
|
|
llr.Inflate(AInflate,AInflate);
|
|
lItem := TMouseHitItem.Create(llr,ARect.Left,ARect.Bottom,2,crSizeNESW,
|
|
tagRectBottomLeft);
|
|
end;
|
|
end;
|
|
end;
|
|
if Assigned(lItem) then
|
|
FMouseHitItems.Add(lItem);
|
|
lItem := Nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TAreaSelectionPlugin.AfterPaint(AMapView: TMapView; var Handled: Boolean);
|
|
|
|
procedure IncRecToMinSize(var ARect : TRect);
|
|
begin
|
|
if Abs(ARect.Left-ARect.Right) < FPenWidth then
|
|
Inc(ARect.Right,FPenWidth);
|
|
if Abs(ARect.Top-ARect.Bottom) < FPenWidth then
|
|
Inc(ARect.Bottom,FPenWidth);
|
|
end;
|
|
|
|
var
|
|
r0 : TRect;
|
|
mapw : Int64;
|
|
topLeftPt, bottomRightPt : TPoint;
|
|
rectW : Integer;
|
|
lRect : TRect;
|
|
ptArr : TPointArray;
|
|
pt : TPoint;
|
|
begin
|
|
Unused(AMapView, Handled);
|
|
|
|
topLeftPt := MapView.LatLonToScreen(FSelectedArea.TopLeft.Lat, FSelectedArea.TopLeft.Lon);
|
|
lRect.Top := topLeftPt.Y;
|
|
lRect.Left := topLeftPt.X;
|
|
bottomRightPt := MapView.LatLonToScreen(FSelectedArea.BottomRight.Lat, FSelectedArea.BottomRight.Lon);
|
|
lRect.Bottom := bottomRightPt.Y;
|
|
lRect.Right := bottomRightPt.X;
|
|
mapw := mvGeoMath.ZoomFactor(MapView.Zoom) * TileSize.CX;
|
|
if lRect.Left > lRect.Right then
|
|
lRect.Left := lRect.Left - mapw;
|
|
rectW := lRect.Right-lRect.Left;
|
|
|
|
MapView.Canvas.Brush.Style := bsClear;
|
|
MapView.Canvas.Pen.Assign(Pen);
|
|
|
|
// Duplicate the rectangles to the dimmed doubled picture areas
|
|
ptArr := MapView.CyclicPointsOf(topLeftPt);
|
|
for pt in ptArr do
|
|
begin
|
|
r0.Left := pt.X;
|
|
r0.Top := lRect.Top;
|
|
r0.Right := pt.X+rectW;
|
|
if r0.Right > MapView.Width+FPenWidth then
|
|
r0.Right := MapView.Width+FPenWidth;
|
|
r0.Bottom := lRect.Bottom;
|
|
if r0.Bottom > MapView.Height+FPenWidth then
|
|
r0.Bottom := MapView.Height+FPenWidth;
|
|
IncRecToMinSize(r0);
|
|
MapView.Canvas.Rectangle(r0);
|
|
end;
|
|
|
|
// Catch the case of the missing left rectangle (draw some rectangles again)
|
|
ptArr := MapView.CyclicPointsOf(bottomRightPt);
|
|
for pt in ptArr do
|
|
begin
|
|
r0.Left := pt.X-rectW;
|
|
if r0.Left < -FPenWidth then
|
|
r0.Left := -FPenWidth;
|
|
r0.Top := lRect.Top;
|
|
if r0.Top < -FPenWidth then
|
|
r0.Top := -FPenWidth;
|
|
r0.Right := pt.X;
|
|
r0.Bottom := lRect.Bottom;
|
|
if r0.Left = r0.Right then
|
|
Inc(r0.Right);
|
|
if r0.Top = r0.Bottom then
|
|
Inc(r0.Bottom);
|
|
IncRecToMinSize(r0);
|
|
MapView.Canvas.Rectangle(r0);
|
|
end;
|
|
end;
|
|
|
|
procedure TAreaSelectionPlugin.MouseMove(AMapView: TMapView; AShift: TShiftState;
|
|
X, Y: Integer; var Handled: Boolean);
|
|
|
|
// The following "PerformXXX" procedures, do the actual adjusting of the
|
|
// side of the active rectangle.
|
|
procedure PerformRightSide(const ANewX : Double; var ARect : TRealArea);
|
|
begin
|
|
if AMapView.Cyclic then
|
|
begin
|
|
ARect.BottomRight.Lon := ANewX;
|
|
Exit;
|
|
end;
|
|
if FShifterXInverseMode then
|
|
begin
|
|
if (ANewX > ARect.BottomRight.Lon) then
|
|
FShifterXInverseMode := False;
|
|
end
|
|
else
|
|
begin
|
|
if (ANewX < ARect.TopLeft.Lon) then
|
|
FShifterXInverseMode := True;
|
|
end;
|
|
if FShifterXInverseMode then
|
|
ARect.TopLeft.Lon := ANewX
|
|
else
|
|
ARect.BottomRight.Lon := ANewX;
|
|
end;
|
|
|
|
procedure PerformLeftSide(const ANewX : Double; var ARect : TRealArea);
|
|
begin
|
|
if AMapView.Cyclic then
|
|
begin
|
|
ARect.TopLeft.Lon := ANewX;
|
|
Exit;
|
|
end;
|
|
if FShifterXInverseMode then
|
|
begin
|
|
if (ANewX < ARect.TopLeft.Lon) then
|
|
FShifterXInverseMode := False;
|
|
end
|
|
else
|
|
begin
|
|
if (ANewX > ARect.BottomRight.Lon) then
|
|
FShifterXInverseMode := True;
|
|
end;
|
|
if FShifterXInverseMode then
|
|
ARect.BottomRight.Lon := ANewX
|
|
else
|
|
ARect.TopLeft.Lon := ANewX;
|
|
end;
|
|
|
|
procedure PerformTopSide(const ANewY : Double; var ARect : TRealArea);
|
|
begin
|
|
if FShifterYInverseMode then
|
|
begin
|
|
if (ANewY < ARect.TopLeft.Lat) then
|
|
FShifterYInverseMode := False;
|
|
end
|
|
else
|
|
begin
|
|
if (ANewY > ARect.BottomRight.Lat) then
|
|
FShifterYInverseMode := True;
|
|
end;
|
|
if FShifterYInverseMode then
|
|
ARect.BottomRight.Lat := ANewY
|
|
else
|
|
ARect.TopLeft.Lat := ANewY;
|
|
end;
|
|
|
|
procedure PerformBottomSide(const ANewY : Double; var ARect : TRealArea);
|
|
begin
|
|
if FShifterYInverseMode then
|
|
begin
|
|
if (ANewY > ARect.BottomRight.Lat) then
|
|
FShifterYInverseMode := False;
|
|
end
|
|
else
|
|
begin
|
|
if (ANewY < ARect.TopLeft.Lat) then
|
|
FShifterYInverseMode := True;
|
|
end;
|
|
if FShifterYInverseMode then
|
|
ARect.TopLeft.Lat := ANewY
|
|
else
|
|
ARect.BottomRight.Lat := ANewY;
|
|
end;
|
|
|
|
var
|
|
w, h : Double;
|
|
lx,ly: Double;
|
|
lRect0 : TRealArea;
|
|
lHitItem : TMouseHitItem;
|
|
ptR : TRealPoint;
|
|
chgAllowed : Boolean;
|
|
var
|
|
i : Integer;
|
|
lItem : TMouseHitItem;
|
|
begin
|
|
if Handled then Exit;
|
|
for i := 0 to ItemsCount-1 do
|
|
begin
|
|
lItem := TMouseHitItem(FMouseHitItems[i]);
|
|
lItem.OnMouseMove(AShift,X,Y);
|
|
end;
|
|
lHitItem := CurrentItem;
|
|
Handled := Assigned(lHitItem);
|
|
// Here we have to act carefully, since we should not change the Mouse Pointer
|
|
// if we not had set him.
|
|
if (not Handled) and FLastMouseMoveHandled then
|
|
MapView.Cursor := crDefault; // no hit, but hit previously, set the default cursor
|
|
FLastMouseMoveHandled := Handled;
|
|
if not Handled then Exit;
|
|
// lHitItem will be assigned if one item is selected.
|
|
MapView.Cursor := lHitItem.Cursor; // Set the cursor to the hit items kind
|
|
if lHitItem.MouseDownFlag then // if the mouse is down
|
|
begin
|
|
lRect0.Init(FSelectedArea.TopLeft,FSelectedArea.BottomRight);
|
|
// Invert the axis to ease calculation
|
|
lRect0.TopLeft.Lat := -lRect0.TopLeft.Lat;
|
|
lRect0.BottomRight.Lat := -lRect0.BottomRight.Lat;
|
|
FMouseMapCoords := MapView.ScreenToLatLon(Point(X,Y));
|
|
ptR := MapView.ScreenToLatLon(Point(lHitItem.OrgX+lHitItem.MouseDeltaX,
|
|
lHitItem.OrgY+lHitItem.MouseDeltaY));
|
|
ptR.Lat := -ptR.Lat;
|
|
lx := ptR.Lon;
|
|
ly := ptR.Lat;
|
|
// case of the several actions
|
|
case (lHitItem.Tag and $F) of
|
|
tagRectArea :
|
|
begin
|
|
// Special operation for the movement of the full rectangle.
|
|
// Just locate the rectangle at the new position ...
|
|
w := RealAreaWidth(lRect0);
|
|
h := lRect0.BottomRight.Lat-lRect0.TopLeft.Lat;
|
|
lRect0.TopLeft := ptR;
|
|
lRect0.BottomRight.Lon := lRect0.TopLeft.Lon + w;
|
|
lRect0.BottomRight.Lat := lRect0.TopLeft.Lat + h;
|
|
// ... but disallow shifting beyond the borders
|
|
if MapView.Cyclic then
|
|
begin
|
|
while lRect0.BottomRight.Lon >= 180.0 do
|
|
lRect0.BottomRight.Lon := lRect0.BottomRight.Lon -360.0;
|
|
end
|
|
else
|
|
begin
|
|
// In the flat world model right and left are fixed borders
|
|
if lRect0.BottomRight.Lon >= 180.0 then
|
|
lRect0.TopLeft.Lon := 180.0 - w;
|
|
end;
|
|
// In the flat and cylindrical world model top and bottom are fixed borders
|
|
lRect0.BottomRight.Lat := lRect0.TopLeft.Lat + h;
|
|
if lRect0.BottomRight.Lat >= 90.0 then
|
|
lRect0.TopLeft.Lat := 90.0 - h;
|
|
end;
|
|
tagRectLeft :
|
|
begin
|
|
PerformLeftSide(lx,lRect0);
|
|
end;
|
|
tagRectTop :
|
|
begin
|
|
PerformTopSide(ly,lRect0);
|
|
end;
|
|
tagRectRight :
|
|
begin
|
|
PerformRightSide(lx,lRect0);
|
|
end;
|
|
tagRectBottom :
|
|
begin
|
|
PerformBottomSide(ly,lRect0);
|
|
end;
|
|
tagRectTopLeft :
|
|
begin
|
|
PerformTopSide(ly,lRect0);
|
|
PerformLeftSide(lx,lRect0);
|
|
end;
|
|
tagRectTopRight :
|
|
begin
|
|
PerformTopSide(ly,lRect0);
|
|
PerformRightSide(lx,lRect0);
|
|
end;
|
|
tagRectBottomRight :
|
|
begin
|
|
PerformBottomSide(ly,lRect0);
|
|
PerformRightSide(lx,lRect0);
|
|
end;
|
|
tagRectBottomLeft :
|
|
begin
|
|
PerformBottomSide(ly,lRect0);
|
|
PerformLeftSide(lx,lRect0);
|
|
end;
|
|
end;
|
|
// Now return adjust the changed coords and transform to the world coordinates
|
|
// Invert the axis to ease calculation
|
|
lRect0.TopLeft.Lat := -lRect0.TopLeft.Lat;
|
|
lRect0.BottomRight.Lat := -lRect0.BottomRight.Lat;
|
|
RealAreaNormed(lRect0);
|
|
chgAllowed := True;
|
|
if Assigned(FSelectedAreaChangingEvent) then
|
|
FSelectedAreaChangingEvent(Self, lRect0, chgAllowed);
|
|
if chgAllowed then
|
|
FSelectedArea.Init(lRect0.TopLeft, lRect0.BottomRight);
|
|
MapView.Invalidate; // redraw the map
|
|
end;
|
|
end;
|
|
|
|
procedure TAreaSelectionPlugin.MouseUp(AMapView: TMapView; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer; var Handled: Boolean);
|
|
var
|
|
i : Integer;
|
|
lItem : TMouseHitItem;
|
|
begin
|
|
Unused(AMapView);
|
|
|
|
if Handled then Exit;
|
|
if Button <> FMouseButton then Exit;
|
|
for i := 0 to ItemsCount-1 do
|
|
begin
|
|
lItem := TMouseHitItem(FMouseHitItems[i]);
|
|
lItem.OnMouseUp(Shift,X,Y);
|
|
end;
|
|
SetupRectShifter; // Setup the HelperClass for the current setting
|
|
Handled := True;
|
|
if Assigned(FSelectedAreaChangedEvent) then
|
|
FSelectedAreaChangedEvent(Self);
|
|
end;
|
|
|
|
procedure TAreaSelectionPlugin.MouseDown(AMapView: TMapView;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer; var Handled: Boolean
|
|
);
|
|
var
|
|
i : Integer;
|
|
lItem, lCurrItem : TMouseHitItem;
|
|
begin
|
|
Unused(AMapView);
|
|
|
|
if Handled then Exit;
|
|
if Button <> FMouseButton then Exit;
|
|
// Forward the MouseDown-Event to all Items
|
|
for i := 0 to ItemsCount-1 do
|
|
begin
|
|
lItem := TMouseHitItem(FMouseHitItems[i]);
|
|
lItem.OnMouseDown(Shift,X,Y);
|
|
end;
|
|
|
|
lCurrItem := GetCurrentItem;
|
|
Handled := Assigned(lCurrItem); // Reserve this event for us (Prvent dragging the map)
|
|
|
|
// Resetting all other Item's MouseDown-Flags but not from the current item.
|
|
// Might not be necessary, but double tap ;-)
|
|
if Assigned(lCurrItem) then
|
|
begin
|
|
for i := 0 to ItemsCount-1 do
|
|
begin
|
|
lItem := TMouseHitItem(FMouseHitItems[i]);
|
|
if lItem = lCurrItem then Continue;
|
|
if lItem.MouseDownFlag then
|
|
lItem.FMouseDownFlag := False;
|
|
end;
|
|
end;
|
|
// Reset the inverters
|
|
FShifterXInverseMode := False;
|
|
FShifterYInverseMode := False;
|
|
end;
|
|
|
|
procedure TAreaSelectionPlugin.CenterMove(AMapView: TMapView;
|
|
var Handled: Boolean);
|
|
begin
|
|
Unused(AMapView, Handled);
|
|
|
|
SetupRectShifter;
|
|
end;
|
|
|
|
procedure TAreaSelectionPlugin.ZoomChange(AMapView: TMapView;
|
|
var Handled: Boolean);
|
|
begin
|
|
Unused(AMapView, Handled);
|
|
|
|
SetupRectShifter;
|
|
end;
|
|
|
|
procedure TAreaSelectionPlugin.Resize(AMapView: TMapView; var Handled: Boolean);
|
|
begin
|
|
Unused(AMapView, Handled);
|
|
SetupRectShifter;
|
|
end;
|
|
|
|
{ SetupRectShifter will fill the Helper Class for the mouse movement with the
|
|
values, so that the mouse pointer will show sensitive items }
|
|
type
|
|
TRectArr = array of TRect;
|
|
|
|
procedure TAreaSelectionPlugin.SetupRectShifter;
|
|
var
|
|
r0 : TRect;
|
|
mapw : Int64;
|
|
topLeftPt, bottomRightPt : TPoint;
|
|
rectW : Integer;
|
|
pt : TPoint;
|
|
lRect : TRect;
|
|
ptArr : TPointArray;
|
|
rArr : TRectArr = Nil;
|
|
i : Integer;
|
|
found : Boolean;
|
|
begin
|
|
Clear;
|
|
|
|
topLeftPt := MapView.LatLonToScreen(FSelectedArea.TopLeft.Lat, FSelectedArea.TopLeft.Lon);
|
|
lRect.Top := topLeftPt.Y;
|
|
lRect.Left := topLeftPt.X;
|
|
bottomRightPt := MapView.LatLonToScreen(FSelectedArea.BottomRight.Lat, FSelectedArea.BottomRight.Lon);
|
|
lRect.Bottom := bottomRightPt.Y;
|
|
lRect.Right := bottomRightPt.X;
|
|
mapw := mvGeoMath.ZoomFactor(MapView.Zoom) * TileSize.CX;
|
|
if lRect.Left > lRect.Right then
|
|
lRect.Left := lRect.Left - mapw;
|
|
rectW := lRect.Right-lRect.Left;
|
|
|
|
// Rectangles might be duplicated in the cyclic view
|
|
ptArr := MapView.CyclicPointsOf(topLeftPt);
|
|
SetLength(rArr,Length(ptArr));
|
|
for i := 0 to High(ptArr) do
|
|
begin
|
|
pt := ptArr[i];
|
|
r0.Left := pt.X;
|
|
r0.Top := lRect.Top;
|
|
r0.Right := pt.X+rectW;
|
|
r0.Bottom := lRect.Bottom;
|
|
rArr[i] := r0;
|
|
AddSelectionArea(r0,FAreaInflation);
|
|
end;
|
|
|
|
// Catch the case of the missing left rectangle.
|
|
ptArr := MapView.CyclicPointsOf(bottomRightPt);
|
|
for pt in ptArr do
|
|
begin
|
|
r0.Left := pt.X-rectW;
|
|
r0.Top := lRect.Top;
|
|
r0.Right := pt.X;
|
|
r0.Bottom := lRect.Bottom;
|
|
found := False;
|
|
for i := 0 to High(rArr) do
|
|
begin
|
|
if r0 = rArr[i] then
|
|
begin
|
|
found := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
if not found then
|
|
AddSelectionArea(r0,FAreaInflation);
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
RegisterPluginClass(TAreaSelectionPlugin, 'Area selection');
|
|
|
|
end.
|
|
|