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

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

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

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

@ -122,6 +122,7 @@ Type
procedure GetMapProviders(lstProviders: TStrings);
function GetVisibleArea: TRealArea;
function LonLatToScreen(aPt: TRealPoint): TPoint;
function ObjsAtScreenPt(X, Y: Integer; ATolerance: Integer = -1): TGPSObjarray;
procedure SaveToFile(AClass: TRasterImageClass; const AFileName: String);
function SaveToImage(AClass: TRasterImageClass): TRasterImage;
procedure SaveToStream(AClass: TRasterImageClass; AStream: TStream);
@ -943,6 +944,33 @@ begin
Engine.Jobqueue.WaitAllJobTerminated(Engine);
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);
var
Area: TRealArea;