pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

LazMapViewer: Add new TMapView method ObjsAtScreenPt to detect the GPS object under the mouse.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8106 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2021-09-30 12:57:54 +00:00
parent d6c8a34a63
commit c155c7646e
2 changed files with 46 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
components/lazmapviewer/examples/fulldemo/main.pas
View File

@ -485,26 +485,21 @@ end;
procedure TMainForm.MapViewMouseMove(Sender: TObject; Shift: TShiftState; procedure TMainForm.MapViewMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer); X, Y: Integer);
const
DELTA = 3;
var var
rArea: TRealArea; objs: TGpsObjArray;
gpsList: TGpsObjList;
L: TStrings; L: TStrings;
i: Integer; i: Integer;
begin begin
UpdateCoords(X, Y); UpdateCoords(X, Y);
rArea.TopLeft := MapView.ScreenToLonLat(Point(X-DELTA, Y-DELTA)); objs := MapView.ObjsAtScreenPt(X, Y);
rArea.BottomRight := MapView.ScreenToLonLat(Point(X+DELTA, Y+DELTA)); if Length(objs) > 0 then
gpsList := MapView.GpsItems.GetObjectsInArea(rArea); begin
try
if gpsList.Count > 0 then begin
L := TStringList.Create; L := TStringList.Create;
try try
for i:=0 to gpsList.Count-1 do for i := 0 to High(objs) do
if gpsList[i] is TGpsPoint then if objs[i] is TGpsPoint then
with TGpsPoint(gpsList[i]) do with TGpsPoint(objs[i]) do
L.Add(Format('%s (%s / %s)', [ L.Add(Format('%s (%s / %s)', [
Name, LatToStr(Lat, USE_DMS), LonToStr(Lon, USE_DMS) Name, LatToStr(Lat, USE_DMS), LonToStr(Lon, USE_DMS)
])); ]));
@ -514,9 +509,6 @@ begin
end; end;
end else end else
GPSPointInfo.Caption := ''; GPSPointInfo.Caption := '';
finally
gpsList.Free;
end;
end; end;
procedure TMainForm.MapViewMouseUp(Sender: TObject; Button: TMouseButton; procedure TMainForm.MapViewMouseUp(Sender: TObject; Button: TMouseButton;

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

@ -122,6 +122,7 @@ Type
procedure GetMapProviders(lstProviders: TStrings); procedure GetMapProviders(lstProviders: TStrings);
function GetVisibleArea: TRealArea; function GetVisibleArea: TRealArea;
function LonLatToScreen(aPt: TRealPoint): TPoint; function LonLatToScreen(aPt: TRealPoint): TPoint;
function ObjsAtScreenPt(X, Y: Integer; ATolerance: Integer = -1): TGPSObjarray;
procedure SaveToFile(AClass: TRasterImageClass; const AFileName: String); procedure SaveToFile(AClass: TRasterImageClass; const AFileName: String);
function SaveToImage(AClass: TRasterImageClass): TRasterImage; function SaveToImage(AClass: TRasterImageClass): TRasterImage;
procedure SaveToStream(AClass: TRasterImageClass; AStream: TStream); procedure SaveToStream(AClass: TRasterImageClass; AStream: TStream);
@ -943,6 +944,33 @@ begin
Engine.Jobqueue.WaitAllJobTerminated(Engine); Engine.Jobqueue.WaitAllJobTerminated(Engine);
end; end;
function TMapView.ObjsAtScreenPt(X, Y: Integer; ATolerance: Integer = -1): TGPSObjarray;
const
DELTA = 3;
var
rArea: TRealArea;
gpsList: TGPSObjList;
i: Integer;
begin
if ATolerance = -1 then
ATolerance := DELTA;
// Define area of +/-ATolerance pixels around the screen point
rArea.TopLeft := ScreenToLonLat(Point(X-ATolerance, Y-ATolerance));
rArea.BottomRight := ScreenToLonLat(Point(X+ATolerance, Y+ATolerance));
// Collect Objects in this are
gpsList := FGPSItems.GetObjectsInArea(rArea);
try
SetLength(Result, gpsList.Count);
for i := 0 to gpsList.Count-1 do
if gpsList[i] is TGPSPoint then
Result[i] := gpsList[i];
finally
gpsList.Free;
end;
end;
procedure TMapView.CenterOnObj(obj: TGPSObj); procedure TMapView.CenterOnObj(obj: TGPSObj);
var var
Area: TRealArea; Area: TRealArea;