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

LazMapViewer: HitTest method added to TMapItem, TMapCollection. Intersect() zerodiv fix. TMapView.LatLonToScreen overload with lat,lon.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9306 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alpine-a110 2024-04-02 10:54:31 +00:00
parent 1ab5a3d877
commit 7e5d6eff6b
2 changed files with 117 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/lazmapviewer/source/mvdrawingengine.pas
View File

@ -138,7 +138,9 @@ begin
Dec(P3.Y);
Inc(P4.Y);
d := (P1.X - P2.X) * (P3.Y - P4.Y) - (P1.Y - P2.Y) * (P3.X - P4.X);
f2 := True;
if d > 0.0
then f2 := True
else Exit;
end;
t := (P1.X - P3.X) * (P3.Y - P4.Y) - (P1.Y - P3.Y) * (P3.X - P4.X);
if (Sign(t) * Sign(d) < 0) or (Abs(t) > Abs(d)) then // 0 <= t/d <= 1

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

@ -28,7 +28,7 @@ interface
uses
Classes, SysUtils, Controls, GraphType, Graphics, FPImage, IntfGraphics,
Forms, ImgList, LCLVersion,
Forms, ImgList, LCLVersion, fgl,
MvTypes, MvGPSObj, MvEngine, MvMapProvider, MvDownloadEngine, MvDrawingEngine,
mvCache, mvExtraData;
@ -52,6 +52,7 @@ const
DefaultMapViewOptions = [mvoMouseDragging, mvoMouseZooming];
type
TMapItem = class;
TMapView = class;
TMapPoint = class;
TMapLayer = class;
@ -69,6 +70,42 @@ type
TMapTrackDrawEvent = procedure(Sender: TObject;
ADrawer: TMvCustomDrawingEngine; ATrack: TMapTrack) of object;
{ TMapObjectList }
TMapObjectList = class(specialize TFPGObjectList<TObject>)
public
constructor Create(ASingleObj: TObject = Nil); reintroduce;
constructor Create(AList: TMapObjectList);
class function AddListToResult(AList, AResult: TMapObjectList): TMapObjectList;
end;
{ TMapItem }
TMapItem = class(TCollectionItem)
private
FCaption: TCaption;
FTag: PtrInt;
FVisible: Boolean;
function GetGPSObj: TGPSObj; virtual; abstract;
function GetView: TMapView; virtual;
function GetLayer: TMapLayer; virtual;
procedure SetCaption(AValue: TCaption);
procedure SetVisible(AValue: Boolean);
protected
function GetDisplayName: string; override;
procedure SetIndex(Value: Integer); override;
procedure ItemChanged; virtual; abstract;
public
function HitTest(constref Area: TRealArea): TMapObjectList; virtual; abstract;
property View: TMapView read GetView;
property Layer: TMapLayer read GetLayer;
PROPERTY GPSObj: TGPSObj read GetGPSObj;
published
property Caption: TCaption read FCaption write SetCaption;
property Visible: Boolean read FVisible write SetVisible default True;
property Tag: PtrInt read FTag write FTag default 0;
end;
{ TMapCollectionBase }
TMapCollectionBase = class(TOwnedCollection)
@ -87,7 +124,7 @@ type
{ TMapCollection }
generic TMapCollection<T, OT: class> = class(TMapCollectionBase)
generic TMapCollection<T: TMapItem; OT: class> = class(TMapCollectionBase)
private
type
TItemClass = T;
@ -100,38 +137,13 @@ type
procedure SetItems(Index: Integer; AValue: TItemClass);
public
constructor Create(AOwner: OT; ABaseZ: Integer);
function HitTest(constref Area: TRealArea): TMapObjectList; virtual;
property MCOwner: TOwnerClass read FMCOwner;
property First: TItemClass read GetFirst;
property Last: TItemClass read GetLast;
property Items[Index: Integer]: TItemClass read GetItems write SetItems; default;
end;
{ TMapItem }
TMapItem = class(TCollectionItem)
private
FCaption: TCaption;
FTag: PtrInt;
FVisible: Boolean;
function GetGPSObj: TGPSObj; virtual; abstract;
function GetView: TMapView; virtual;
function GetLayer: TMapLayer; virtual;
procedure SetCaption(AValue: TCaption);
procedure SetVisible(AValue: Boolean);
protected
function GetDisplayName: string; override;
procedure ItemChanged; virtual; abstract;
procedure SetIndex(Value: Integer); override;
public
property View: TMapView read GetView;
property Layer: TMapLayer read GetLayer;
PROPERTY GPSObj: TGPSObj read GetGPSObj;
published
property Caption: TCaption read FCaption write SetCaption;
property Visible: Boolean read FVisible write SetVisible default True;
property Tag: PtrInt read FTag write FTag default 0;
end;
{ TMapLayer }
TMapLayer = class(TMapItem)
@ -162,6 +174,7 @@ type
public
constructor Create(ACollection: TCollection); override;
destructor Destroy; override;
function HitTest(constref Area: TRealArea): TMapObjectList; override;
procedure AssignFromGPSList(AList: TGPSObjectList);
property ComboLayer: TGPSComboLayer read FComboLayer;
published
@ -229,6 +242,7 @@ type
constructor Create(ACollection: TCollection); override;
destructor Destroy; override;
procedure AssignTo(Dest: TPersistent); override;
function HitTest(constref Area: TRealArea): TMapObjectList; override;
property LatLonInDMS: Boolean read GetLatLonInDMS;
property ToScreen: TPoint read GetToScreen;
published
@ -325,6 +339,7 @@ type
constructor Create(ACollection: TCollection); override;
destructor Destroy; override;
procedure ItemChanged; override;
function HitTest(constref Area: TRealArea): TMapObjectList; override;
published
//property DateTime: TDateTime read GetDateTime write FDateTime;
property LineColor: TColor read FLineColor write SetLineColor default clDefault;
@ -474,6 +489,7 @@ type
procedure GetMapProviders(lstProviders: TStrings);
function GetVisibleArea: TRealArea;
function LatLonToScreen(aPt: TRealPoint): TPoint;
function LatLonToScreen(Lat, Lon: Double): TPoint; overload;
function LonLatToScreen(aPt: TRealPoint): TPoint; deprecated 'Use LatLonToScreen';
function ObjsAtScreenPt(X, Y: Integer; ATolerance: Integer = -1): TGPSObjarray;
procedure SaveToFile(AClass: TRasterImageClass; const AFileName: String);
@ -655,6 +671,35 @@ type
destructor Destroy; override;
end;
{ TMapObjectList }
constructor TMapObjectList.Create(ASingleObj: TObject);
begin
inherited Create(False);
if Assigned(ASingleObj) then
Add(ASingleObj);
end;
constructor TMapObjectList.Create(AList: TMapObjectList);
begin
inherited Create(False);
if Assigned(AList) then
AddList(AList);
end;
class function TMapObjectList.AddListToResult(AList, AResult: TMapObjectList): TMapObjectList;
begin
Result := AResult;
if Assigned(AList) then
if Assigned(AResult) then
begin
Result.AddList(AList);
AList.Free;
end
else
Result := AList;
end;
{ TMapTrackPoint }
function TMapTrackPoint.CreatePoint: TGPSPoint;
@ -874,6 +919,13 @@ begin
Changed(False);
end;
function TMapTrack.HitTest(constref Area: TRealArea): TMapObjectList;
begin
Result := Points.HitTest(Area);
if Assigned(Result) then
Result.Add(Self);
end;
{ TMapTracks }
function TMapTracks.GetLayer: TMapLayer;
@ -950,6 +1002,17 @@ begin
(GetItems(Index) as TPersistent).Assign(AValue);
end;
function TMapCollection.HitTest(constref Area: TRealArea): TMapObjectList;
var
I: TCollectionItem;
begin
Result := Nil;
for I in Self do
Result := TMapObjectList.AddListToResult(TItemClass(I).HitTest(Area), Result);
if Assigned(Result) then
Result.Add(Self);
end;
constructor TMapCollection.Create(AOwner: OT; ABaseZ: Integer);
begin
inherited Create(AOwner, TItemClass);
@ -1069,6 +1132,18 @@ begin
Changed(False);
end;
function TMapPoint.HitTest(constref Area: TRealArea): TMapObjectList;
var
BB: TRealArea;
begin
Result := Nil;
if not Visible then
Exit;
BB := Self.GPSObj.BoundingBox;
if Area.ContainsPoint(BB.TopLeft) and Area.ContainsPoint(BB.BottomRight)
then Result := TMapObjectList.Create(Self);
end;
function TMapPoint.CreatePoint: TGPSPoint;
begin
Result := TGPSPoint.Create(FLongitude, FLatitude);
@ -1347,6 +1422,12 @@ begin
inherited Destroy;
end;
function TMapLayer.HitTest(constref Area: TRealArea): TMapObjectList;
begin
Result := TMapObjectList.AddListToResult(PointsOfInterest.HitTest(Area),
Tracks.HitTest(Area));
end;
procedure TMapLayer.AssignFromGPSList(AList: TGPSObjectList);
procedure AddPoint(APoint: TGPSPoint);
@ -2639,6 +2720,11 @@ begin
Result := Engine.LatLonToScreen(aPt);
end;
function TMapView.LatLonToScreen(Lat, Lon: Double): TPoint;
begin
Result := LatLonToScreen(RealPoint(Lat, Lon));
end;
function TMapView.LonLatToScreen(aPt: TRealPoint): TPoint;
begin
Result := Engine.LatLonToScreen(aPt);