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

LazMapViewer: Drag button check (mbLeft) moved from Engine to MapView. Added Start/End/AbortDragging methods. GetObjectsInArea with a class filter.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9288 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alpine-a110 2024-03-28 13:36:09 +00:00
parent 8651b681b3
commit b651135f37
3 changed files with 294 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
components/lazmapviewer/source/mvengine.pas
View File

@ -859,8 +859,7 @@ end;
procedure TMapViewerEngine.MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
FDragObj.MouseDown(self,X,Y);
FDragObj.MouseDown(self,X,Y);
end;
procedure TMapViewerEngine.MouseMove(Sender: TObject; Shift: TShiftState;
@ -872,8 +871,7 @@ end;
procedure TMapViewerEngine.MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
FDragObj.MouseUp(X,Y);
FDragObj.MouseUp(X,Y);
end;
procedure TMapViewerEngine.MouseWheel(Sender: TObject;

126
components/lazmapviewer/source/mvgpsobj.pas
View File

@ -25,6 +25,7 @@ const
type
TIdArray = Array of integer;
TGPSObj = class;
TGPSObjClass = class of TGPSObj;
TGPSObjDrawEvent = procedure(Sender: TObject; AGPSObj: TGPSObj;
AArea: TRealArea) of object;
@ -105,29 +106,54 @@ type
procedure Draw({%H-}AView: TObject; {%H-}Area: TRealArea); override;
property ImageIndex: Integer read FImageIndex write FImageIndex default -1;
end;
{ TGPSPolyLine }
TGPSPolyLine = class(TGPSObj)
private
FPoints: TGPSPointList;
public
constructor Create;
destructor Destroy; override;
procedure GetArea(out Area: TRealArea); override;
property Points: TGPSPointList read FPoints;
end;
{ TGPSTrack }
TGPSTrack = class(TGPSObj)
TGPSTrack = class(TGPSPolyLine)
private
FDateTime: TDateTime;
FPoints: TGPSPointList;
FLineWidth: Double; // Line width in mm
FLineColor: TColor;
function GetDateTime: TDateTime;
public
constructor Create;
destructor Destroy; override;
procedure GetArea(out Area: TRealArea); override;
procedure Draw({%H-}AView: TObject; {%H-}Area: TRealArea); override;
function TrackLengthInKm(UseEle: Boolean=true): double;
property Points: TGPSPointList read FPoints;
property DateTime: TDateTime read GetDateTime write FDateTime;
property LineColor: TColor read FLineColor write FLineColor;
property LineWidth: Double read FLineWidth write FLineWidth;
end;
{ TGPSArea }
TGPSArea = class(TGPSPolyLine)
private
FFillColor: TColor;
FLineColor: TColor;
FLineWidth: Double;
public
constructor Create;
procedure Draw({%H-}AView: TObject; {%H-}Area: TRealArea); override;
property FillColor: TColor read FFillColor write FFillColor;
property LineColor: TColor read FLineColor write FLineColor;
property LineWidth: Double read FLineWidth write FLineWidth;
end;
TGPSObjList_ = specialize TFPGObjectList<TGPSObj>;
{ TGPSObjList }
@ -169,7 +195,7 @@ type
out Notfound: TIdArray);
procedure GetArea(out Area: TRealArea); override;
procedure Draw({%H-}AView: TObject; {%H-}Area: TRealArea); override;
function GetObjectsInArea(const Area: TRealArea): TGPSObjList;
function GetObjectsInArea(const Area: TRealArea; AClass: TGPSObjClass = Nil): TGPSObjList;
function GetIdsArea(const Ids: TIdArray; AIdOwner: integer): TRealArea;
function Add(aItem: TGpsObj; AIdOwner: Integer; AZOrder: Integer = 0): Integer;
@ -251,6 +277,58 @@ begin
end;
end;
{ TGPSArea }
constructor TGPSArea.Create;
begin
inherited;
FFillColor := clNone;
FLineColor := clDefault; // --> use MapView.DefaultTrackColor
FLineWidth := -1; // --> use MapView.DefaultTrackWidth
end;
procedure TGPSArea.Draw(AView: TObject; Area: TRealArea);
begin
TMapView(AView).DrawArea(Area, Self);
end;
{ TGPSPolyLine }
constructor TGPSPolyLine.Create;
begin
inherited;
FPoints := TGPSPointList.Create(true);
end;
destructor TGPSPolyLine.Destroy;
begin
inherited Destroy;
FreeAndNil(FPoints);
end;
procedure TGPSPolyLine.GetArea(out Area: TRealArea);
var
i: integer;
ptArea: TRealArea;
pt1, pt2: TRealPoint;
begin
Area.Init(0, 0, 0, 0);
if FPoints.Count > 0 then
begin
pt1 := FPoints[0].RealPoint;
Area := FPoints[0].BoundingBox;
for i:=1 to pred(FPoints.Count) do
begin
pt2 := FPoints[I].RealPoint;
if GoingEast(pt1.Lon, pt2.Lon)
then ptArea.Init(pt1.Lon, Max(pt1.Lat, pt2.Lat), pt2.Lon, Min(pt1.Lat, pt2.Lat))
else ptArea.Init(pt2.Lon, Max(pt1.Lat, pt2.Lat), pt1.Lon, Min(pt1.Lat, pt2.Lat));
ExtendArea(Area, ptArea);
pt1 := pt2;
end;
end;
end;
{ TGPSObjList }
destructor TGPSObjList.Destroy;
@ -435,7 +513,8 @@ begin
//;
end;
function TGPSObjectList.GetObjectsInArea(const Area: TRealArea): TGPSObjList;
function TGPSObjectList.GetObjectsInArea(const Area: TRealArea;
AClass: TGPSObjClass {= Nil}): TGPSObjList;
var
I: integer;
ItemArea: TRealArea;
@ -447,7 +526,9 @@ begin
for I := 0 to Pred(Count) do
begin
ItemArea := Items[I].BoundingBox;
if hasIntersectArea(Area,ItemArea) then
if (not Assigned(AClass) or (Items[I] is AClass)) and
hasIntersectArea(Area,ItemArea)
then
Result.Add(Items[I]);
end;
if Result.Count > 0 then
@ -772,39 +853,10 @@ end;
constructor TGPSTrack.Create;
begin
inherited;
FPoints := TGPSPointList.Create(true);
FLineColor := clDefault; // --> use MapView.DefaultTrackColor
FLineWidth := -1; // --> use MapView.DefaultTrackWidth
end;
destructor TGPSTrack.Destroy;
begin
inherited Destroy;
FreeAndNil(FPoints);
end;
procedure TGPSTrack.GetArea(out Area: TRealArea);
var
i: integer;
ptArea: TRealArea;
pt1, pt2: TRealPoint;
begin
Area.Init(0, 0, 0, 0);
if FPoints.Count > 0 then
begin
pt1 := FPoints[0].RealPoint;
Area := FPoints[0].BoundingBox;
for i:=1 to pred(FPoints.Count) do
begin
pt2 := FPoints[I].RealPoint;
if GoingEast(pt1.Lon, pt2.Lon)
then ptArea.Init(pt1.Lon, Max(pt1.Lat, pt2.Lat), pt2.Lon, Min(pt1.Lat, pt2.Lat))
else ptArea.Init(pt2.Lon, Max(pt1.Lat, pt2.Lat), pt1.Lon, Min(pt1.Lat, pt2.Lat));
ExtendArea(Area, ptArea);
pt1 := pt2;
end;
end;
end;
procedure TGPSTrack.Draw(AView: TObject; Area: TRealArea);
begin

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

@ -50,6 +50,8 @@ type
TMapView = class;
TPointOfInterest = class;
TPointsOfInterest = class;
TMapTrack = class;
TMapTracks = class;
TGPSTileLayer = class;
TGPSComboLayer = class;
@ -97,14 +99,17 @@ type
FMapProvider: String;
FOpacity: Single;
FPointsOfInterest: TPointsOfInterest;
FTracks: TMapTracks;
function GetMapProvider: String;
function GetMapView: TMapView;
function GetPointsOfInterest: TPointsOfInterest;
function GetTracks: TMapTracks;
function GetUseThreads: Boolean;
procedure SetDrawMode(AValue: TItemDrawMode);
procedure SetMapProvider(AValue: String);
procedure SetOpacity(AValue: Single);
procedure SetPointsOfInterest(AValue: TPointsOfInterest);
procedure SetTracks(AValue: TMapTracks);
procedure SetUseThreads(AValue: Boolean);
protected
procedure SetIndex(Value: Integer); override;
@ -121,6 +126,7 @@ type
property DrawMode: TItemDrawMode read FDrawMode write SetDrawMode default idmUseOpacity;
property Opacity: Single read FOpacity write SetOpacity default 0.25;
property PointsOfInterest: TPointsOfInterest read GetPointsOfInterest write SetPointsOfInterest;
property Tracks: TMapTracks read GetTracks write SetTracks;
end;
{ TMapLayers }
@ -201,6 +207,48 @@ type
procedure FixOrder(APrevIndex, AIndex: Integer);
end;
{ TMapPolygon }
TMapPolygon = class(TMapItem)
private
FPoints: TGPSPointList;
published
property Points: TGPSPointList read FPoints;
end;
TMapTrackSegment = class(TMapPolygon)
end;
TMapTrackSegments = class(specialize TMapCollection<TMapTrackSegment, TMapTrack>)
end;
{ TMapTrack }
TMapTrack = class(TMapItem)
private
FLineColor: TColor;
FLineWidth: Double;
FSegments: TMapTrackSegments;
public
constructor Create(ACollection: TCollection); override;
destructor Destroy; override;
published
property Segments: TMapTrackSegments read FSegments write FSegments;
//property DateTime: TDateTime read GetDateTime write FDateTime;
property LineColor: TColor read FLineColor write FLineColor;
property LineWidth: Double read FLineWidth write FLineWidth;
end;
{ TMapTracks }
TMapTracks = class(specialize TMapCollection<TMapTrack, TMapLayer>)
protected
procedure Update(Item: TCollectionItem); override;
end;
{ TMapView }
TMapView = class(TCustomControl)
@ -323,9 +371,12 @@ type
destructor Destroy; override;
function CyclicPointOf(APoint: TPoint; ARefX: LongInt; Eastwards: Boolean = True): TPoint;
function CyclicPointsOf(APoint: TPoint): TPointArray;
function TrackLineColor(AColor: TColor; ExtraData: TObject): TColor;
function TrackLineWidth(AWidth: Double; ExtraData: TObject): Integer;
procedure DrawPointOfInterest(const {%H-}Area: TRealArea; APt: TGPSPointOfInterest);
procedure DrawPt(const {%H-}Area: TRealArea; APt: TGPSPoint);
procedure DrawTrack(const Area: TRealArea; trk: TGPSTrack);
procedure DrawTrack(const {%H-}Area: TRealArea; trk: TGPSTrack);
procedure DrawArea(const {%H-}Area: TRealArea; ar: TGPSArea);
procedure ClearBuffer;
procedure GetMapProviders(lstProviders: TStrings);
function GetVisibleArea: TRealArea;
@ -340,6 +391,10 @@ type
procedure ZoomOnArea(const aArea: TRealArea);
procedure ZoomOnObj(obj: TGPSObj);
procedure WaitEndOfRendering;
procedure StartDragging(X, Y: Integer);
procedure EndDragging(X, Y: Integer);
procedure AbortDragging;
property Center: TRealPoint read GetCenter write SetCenter;
property Engine: TMapViewerEngine read FEngine;
property GPSItems: TGPSObjectList read GetGPSItems;
@ -500,6 +555,29 @@ type
destructor Destroy; override;
end;
{ TMapTrack }
constructor TMapTrack.Create(ACollection: TCollection);
begin
inherited Create(ACollection);
FSegments := TMapTrackSegments.Create(Self);
end;
destructor TMapTrack.Destroy;
begin
FSegments.Free;
inherited Destroy;
end;
{ TMapTracks }
procedure TMapTracks.Update(Item: TCollectionItem);
begin
inherited Update(Item);
if Assigned(MCOwner.MapView) then
MCOwner.MapView.Invalidate;
end;
{ TMapItem }
procedure TMapItem.SetCaption(AValue: TCaption);
@ -575,7 +653,7 @@ begin
begin
for I := 0 to Pred(Objs.Count) do
if Objs[I].Visible then
Items[I].Draw(AView, Area)
Objs[I].Draw(AView, Area)
end;
finally
FreeAndNil(Objs);
@ -785,6 +863,11 @@ begin
Result := FPointsOfInterest;
end;
function TMapLayer.GetTracks: TMapTracks;
begin
Result := FTracks;
end;
function TMapLayer.GetMapProvider: String;
begin
Result := FComboLayer.TileLayer.MapProvider
@ -840,6 +923,11 @@ begin
FPointsOfInterest.Assign(AValue);
end;
procedure TMapLayer.SetTracks(AValue: TMapTracks);
begin
FTracks.Assign(AValue);
end;
procedure TMapLayer.SetUseThreads(AValue: Boolean);
begin
if FUseThreads = AValue then
@ -881,6 +969,7 @@ begin
FTag := 0;
FPointsOfInterest := TPointsOfInterest.Create(Self);
FTracks := TMapTracks.Create(Self);
FComboLayer := TGPSComboLayer.Create;
MapView.GPSItems.Add(FComboLayer, _TILELAYERS_ID_, Self.Index - LAYERS_ZOFFS);
end;
@ -888,6 +977,7 @@ end;
destructor TMapLayer.Destroy;
begin
FPointsOfInterest.Free;
FTracks.Free;
if Assigned(FComboLayer) then
MapView.GPSItems.Delete(FComboLayer);
inherited Destroy;
@ -1386,28 +1476,30 @@ procedure TMapView.MouseDown(Button: TMouseButton; Shift: TShiftState;
begin
inherited MouseDown(Button, Shift, X, Y);
if IsActive and (mvoMouseDragging in FOptions) then
begin
Engine.MouseDown(self,Button,Shift,X,Y);
Invalidate;
end;
if Button = mbLeft then
begin
Engine.MouseDown(self,Button,Shift,X,Y);
Invalidate;
end;
end;
procedure TMapView.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
if IsActive and (mvoMouseDragging in FOptions) then
begin
Engine.MouseUp(self,Button,Shift,X,Y);
Engine.Redraw;
Invalidate;
end;
if IsActive then
if Button = mbLeft then
begin
Engine.MouseUp(self,Button,Shift,X,Y);
Engine.Redraw;
Invalidate;
end;
end;
procedure TMapView.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited MouseMove(Shift, X, Y);
if IsActive and (mvoMouseDragging in FOptions) then
if IsActive then
begin
Engine.MouseMove(self,Shift,X,Y);
if Engine.InDrag
@ -1527,6 +1619,52 @@ begin
Engine.Redraw;
end;
procedure TMapView.StartDragging(X, Y: Integer);
begin
Engine.DragObj.MouseDown(Engine, X, Y);
end;
procedure TMapView.EndDragging(X, Y: Integer);
var
Drag: Boolean;
begin
Drag := Engine.InDrag;
Engine.DragObj.MouseUp(X, Y);
if Drag then
Invalidate;
end;
procedure TMapView.AbortDragging;
begin
Engine.DragObj.AbortDrag;
end;
function TMapView.TrackLineColor(AColor: TColor; ExtraData: TObject): TColor;
begin
if AColor = clDefault then
begin
Result := ColorToRGB(FDefaultTrackColor);
if (ExtraData <> Nil) and ExtraData.InheritsFrom(TDrawingExtraData) then
Result := TDrawingExtraData(ExtraData).Color;
end
else
Result := ColorToRGB(AColor);
end;
function TMapView.TrackLineWidth(AWidth: Double; ExtraData: TObject): Integer;
begin
if AWidth = -1 then
begin
Result := FDefaultTrackWidth;
if (ExtraData <> Nil) and ExtraData.InheritsFrom(TTrackExtraData) then
Result := mmToPx(TTrackExtraData(ExtraData).Width);
end
else
Result := mmToPx(AWidth);
if Result < 1 then
Result := 1;
end;
procedure TMapView.DrawTrack(const Area: TRealArea; trk: TGPSTrack);
var
I, L, T, WS: Integer;
@ -1548,24 +1686,10 @@ begin
exit;
// Determine track color
if trk.LineColor = clDefault then
begin
trkColor := ColorToRGB(FDefaultTrackColor);
if (trk.ExtraData <> nil) and trk.ExtraData.InheritsFrom(TDrawingExtraData) then
trkColor := TDrawingExtraData(trk.ExtraData).Color;
end else
trkColor := ColorToRGB(trk.LineColor);
trkColor := TrackLineColor(trk.LineColor, trk.ExtraData);
// Determine track width
if trk.LineWidth = -1 then
begin
trkWidth := FDefaultTrackWidth;
if (trk.ExtraData <> nil) and trk.ExtraData.InheritsFrom(TTrackExtraData) then
trkWidth := mmToPx(TTrackExtraData(trk.ExtraData).Width);
end else
trkWidth := mmToPx(trk.LineWidth);
if trkWidth < 1 then trkWidth := 1;
trkWidth := TrackLineWidth(trk.LineWidth, trk.ExtraData);
DrawingEngine.PenColor := trkColor;
DrawingEngine.PenWidth := trkWidth;
@ -1614,6 +1738,56 @@ begin
end;
end;
procedure TMapView.DrawArea(const Area: TRealArea; ar: TGPSArea);
var
Pts: array of TPoint;
I, C: Integer;
NoFill: Boolean;
WS: Int64;
begin
if not ar.Visible or (ar.Points.Count = 0) then
Exit;
if Cyclic then
begin
WS := ZoomFactor(Zoom) * TILE_SIZE;
if (WS < ClientWidth) then
begin
{TODO Draw multiple copies of the area}
Exit; // Not implemented, exit
end;
end;
{TODO Fix drawing when the area crosses the date line, see DrawTrack}
C := ar.Points.Count;
NoFill := (ar.FillColor = clNone);
if NoFill then
Inc(C);
SetLength(Pts, C);
for I := 0 to Pred(ar.Points.Count) do
Pts[I] := Engine.LonLatToScreen(ar.Points[I].RealPoint);
if NoFill then
Pts[Pred(C)] := Pts[0];
if ar.LineColor = clNone then
DrawingEngine.PenStyle := psClear
else
begin
DrawingEngine.PenStyle := psSolid;
DrawingEngine.PenColor := TrackLineColor(ar.LineColor, ar.ExtraData);
DrawingEngine.PenWidth := TrackLineWidth(ar.LineWidth, ar.ExtraData);
end;
if NoFill then
DrawingEngine.Polyline(Pts)
else
begin
DrawingEngine.BrushStyle := bsSolid;
DrawingEngine.BrushColor := ar.FillColor;
DrawingEngine.Polygon(Pts);
end;
end;
procedure TMapView.DrawPointOfInterest(const Area: TRealArea; APt: TGPSPointOfInterest);
var
pt: TPoint;