lazmapviewer: Add geo distance calculation (patch by sstvmaster, https://forum.lazarus.freepascal.org/index.php/topic,12674.msg318879.html#msg318879).

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6865 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-04-24 22:36:59 +00:00
parent 7b27af735d
commit 6ec131a022
4 changed files with 250 additions and 25 deletions

View File

@ -56,7 +56,7 @@ end;
procedure TGPSListViewer.Populate;
const
GPS_FORMAT = '0.000000';
GPS_FORMAT = '0.00000°';
var
i: Integer;
item: TListItem;

View File

@ -1,10 +1,10 @@
object MainForm: TMainForm
Left = 345
Height = 545
Height = 581
Top = 121
Width = 869
Caption = 'MainForm'
ClientHeight = 545
ClientHeight = 581
ClientWidth = 869
OnCreate = FormCreate
OnDestroy = FormDestroy
@ -13,11 +13,11 @@ object MainForm: TMainForm
LCLVersion = '2.1.0.0'
object ControlPanel: TPanel
Left = 592
Height = 545
Height = 581
Top = 0
Width = 277
Align = alRight
ClientHeight = 545
ClientHeight = 581
ClientWidth = 277
TabOrder = 1
object CbProviders: TComboBox
@ -145,11 +145,11 @@ object MainForm: TMainForm
Left = 16
Height = 15
Top = 23
Width = 46
Width = 43
BorderSpacing.Left = 16
BorderSpacing.Top = 4
BorderSpacing.Bottom = 8
Caption = 'Latitude:'
Caption = 'Latitude'
ParentColor = False
end
object InfoPositionLongitude: TLabel
@ -195,11 +195,11 @@ object MainForm: TMainForm
AnchorSideRight.Side = asrBottom
Left = 9
Height = 66
Top = 185
Top = 181
Width = 259
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Top = 12
BorderSpacing.Top = 8
Caption = 'Center'
ClientHeight = 46
ClientWidth = 255
@ -223,11 +223,11 @@ object MainForm: TMainForm
Left = 16
Height = 15
Top = 23
Width = 46
Width = 43
BorderSpacing.Left = 16
BorderSpacing.Top = 4
BorderSpacing.Bottom = 8
Caption = 'Latitude:'
Caption = 'Latitude'
ParentColor = False
end
object InfoCenterLongitude: TLabel
@ -272,7 +272,7 @@ object MainForm: TMainForm
AnchorSideRight.Control = BtnSearch
Left = 9
Height = 23
Top = 264
Top = 334
Width = 190
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Right = 8
@ -283,13 +283,13 @@ object MainForm: TMainForm
Text = 'New York'
end
object BtnSearch: TButton
AnchorSideTop.Control = GbCenterCoords
AnchorSideTop.Control = GbScreenSize
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GbCenterCoords
AnchorSideRight.Side = asrBottom
Left = 207
Height = 25
Top = 263
Top = 333
Width = 61
Anchors = [akTop, akRight]
AutoSize = True
@ -305,7 +305,7 @@ object MainForm: TMainForm
AnchorSideRight.Control = BtnGoTo
Left = 9
Height = 21
Top = 318
Top = 388
Width = 196
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 4
@ -325,7 +325,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom
Left = 9
Height = 15
Top = 299
Top = 369
Width = 177
BorderSpacing.Top = 12
Caption = 'Select one of the found locations:'
@ -338,7 +338,7 @@ object MainForm: TMainForm
AnchorSideRight.Side = asrBottom
Left = 213
Height = 25
Top = 316
Top = 386
Width = 55
Anchors = [akTop, akRight]
AutoSize = True
@ -354,7 +354,7 @@ object MainForm: TMainForm
AnchorSideRight.Side = asrBottom
Left = 8
Height = 52
Top = 380
Top = 450
Width = 260
Anchors = [akTop, akLeft, akRight]
AutoSize = False
@ -368,7 +368,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom
Left = 8
Height = 25
Top = 347
Top = 417
Width = 92
AutoSize = True
BorderSpacing.Top = 8
@ -383,8 +383,8 @@ object MainForm: TMainForm
AnchorSideRight.Control = InfoBtnGPSPoints
AnchorSideRight.Side = asrBottom
Left = 8
Height = 80
Top = 432
Height = 64
Top = 502
Width = 260
Anchors = [akTop, akLeft, akRight]
AutoSize = False
@ -498,7 +498,7 @@ object MainForm: TMainForm
AnchorSideTop.Control = BtnGPSPoints
Left = 108
Height = 25
Top = 347
Top = 417
Width = 110
AutoSize = True
BorderSpacing.Left = 8
@ -506,10 +506,110 @@ object MainForm: TMainForm
OnClick = BtnSaveToFileClick
TabOrder = 11
end
object GbScreenSize: TGroupBox
AnchorSideLeft.Control = GbCenterCoords
AnchorSideTop.Control = GbCenterCoords
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GbCenterCoords
AnchorSideRight.Side = asrBottom
Left = 9
Height = 66
Top = 255
Width = 259
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Top = 8
Caption = 'Viewport size'
ClientHeight = 46
ClientWidth = 255
TabOrder = 12
object LblViewportWidth: TLabel
AnchorSideLeft.Control = GbScreenSize
AnchorSideTop.Control = GbScreenSize
Left = 16
Height = 15
Top = 4
Width = 32
BorderSpacing.Left = 16
BorderSpacing.Top = 4
Caption = 'Width'
ParentColor = False
end
object LblViewportHeight: TLabel
AnchorSideLeft.Control = GbScreenSize
AnchorSideTop.Control = LblViewportWidth
AnchorSideTop.Side = asrBottom
Left = 16
Height = 15
Top = 23
Width = 36
BorderSpacing.Left = 16
BorderSpacing.Top = 4
BorderSpacing.Bottom = 8
Caption = 'Height'
ParentColor = False
end
object InfoViewportWidth: TLabel
AnchorSideTop.Control = GbScreenSize
AnchorSideRight.Control = GbScreenSize
AnchorSideRight.Side = asrBottom
Left = 205
Height = 15
Top = 4
Width = 34
Alignment = taRightJustify
Anchors = [akTop, akRight]
BorderSpacing.Top = 4
BorderSpacing.Right = 16
Caption = 'Label2'
ParentColor = False
end
object InfoViewportHeight: TLabel
AnchorSideTop.Control = InfoViewportWidth
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GbScreenSize
AnchorSideRight.Side = asrBottom
Left = 205
Height = 15
Top = 23
Width = 34
Alignment = taRightJustify
Anchors = [akTop, akRight]
BorderSpacing.Top = 4
BorderSpacing.Right = 16
BorderSpacing.Bottom = 8
Caption = 'Label2'
ParentColor = False
end
end
object CbDistanceUnits: TComboBox
AnchorSideTop.Control = GbCenterCoords
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GbCenterCoords
AnchorSideRight.Side = asrBottom
Left = 176
Height = 23
Top = 253
Width = 76
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 6
BorderSpacing.Right = 16
ItemHeight = 15
ItemIndex = 1
Items.Strings = (
'm'
'km'
'miles'
)
OnChange = CbDistanceUnitsChange
Style = csDropDownList
TabOrder = 13
Text = 'km'
end
end
object MapView: TMapView
Left = 0
Height = 545
Height = 581
Hint = 'Displays the map'
Top = 0
Width = 592
@ -523,6 +623,7 @@ object MainForm: TMainForm
UseThreads = True
Zoom = 0
OnZoomChange = MapViewZoomChange
OnChange = MapViewChange
OnDrawGpsPoint = MapViewDrawGpsPoint
OnMouseMove = MapViewMouseMove
OnMouseUp = MapViewMouseUp

View File

@ -24,13 +24,19 @@ type
CbProviders: TComboBox;
CbUseThreads: TCheckBox;
CbMouseCoords: TGroupBox;
CbDistanceUnits: TComboBox;
GbCenterCoords: TGroupBox;
GbScreenSize: TGroupBox;
InfoCenterLatitude: TLabel;
InfoViewportHeight: TLabel;
InfoCenterLongitude: TLabel;
InfoBtnGPSPoints: TLabel;
GPSPointInfo: TLabel;
InfoViewportWidth: TLabel;
Label8: TLabel;
LblCenterLatitude: TLabel;
LblViewportHeight: TLabel;
LblViewportWidth: TLabel;
LblPositionLongitude: TLabel;
LblPositionLatitude: TLabel;
InfoPositionLongitude: TLabel;
@ -53,11 +59,13 @@ type
ARect: TRect; State: TOwnerDrawState);
procedure CbProvidersChange(Sender: TObject);
procedure CbUseThreadsChange(Sender: TObject);
procedure CbDistanceUnitsChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure GeoNamesNameFound(const AName: string; const ADescr: String;
const ALoc: TRealPoint);
procedure MapViewChange(Sender: TObject);
procedure MapViewDrawGpsPoint(Sender, ACanvas: TObject; APoint: TGpsPoint);
procedure MapViewMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
@ -72,6 +80,7 @@ type
procedure ClearFoundLocations;
procedure UpdateDropdownWidth(ACombobox: TCombobox);
procedure UpdateLocationHistory(ALocation: String);
procedure UpdateViewportSize;
public
procedure ReadFromIni;
@ -88,7 +97,7 @@ implementation
uses
LCLType, IniFiles, Math, FPCanvas, FPImage, IntfGraphics,
mvExtraData,
mvEngine, mvExtraData,
gpslistform;
type
@ -227,6 +236,11 @@ begin
MapView.UseThreads := CbUseThreads.Checked;
end;
procedure TMainForm.CbDistanceUnitsChange(Sender: TObject);
begin
UpdateViewPortSize;
end;
procedure TMainForm.ClearFoundLocations;
var
i: Integer;
@ -276,6 +290,11 @@ begin
CbFoundLocations.Items.AddObject(AName, P);
end;
procedure TMainForm.MapViewChange(Sender: TObject);
begin
UpdateViewportSize;
end;
procedure TMainForm.MapViewDrawGpsPoint(Sender, ACanvas: TObject;
APoint: TGpsPoint);
const
@ -332,12 +351,20 @@ var
i: Integer;
begin
rPt := MapView.Center;
InfoCenterLongitude.Caption := Format('%.6f° = %s', [rPt.Lon, GPSToDMS(rPt.Lon)]);
InfoCenterLatitude.Caption := Format('%.6f° = %s', [rPt.Lat, GPSToDMS(rPt.Lat)]);
{
InfoCenterLongitude.Caption := Format('%.6f°', [rPt.Lon]);
InfoCenterLatitude.Caption := Format('%.6f°', [rPt.Lat]);
}
rPt := MapView.ScreenToLonLat(Point(X, Y));
InfoPositionLongitude.Caption := Format('%.6f° = %s', [rPt.Lon, GPSToDMS(rPt.Lon)]);
InfoPositionLatitude.Caption := Format('%.6f° = %s', [rPt.Lat, GPSToDMS(rPt.Lat)]);
{
InfoPositionLongitude.Caption := Format('%.6f°', [rPt.Lon]);
InfoPositionLatitude.Caption := Format('%.6f°', [rPt.Lat]);
}
rArea.TopLeft := MapView.ScreenToLonLat(Point(X-DELTA, Y-DELTA));
rArea.BottomRight := MapView.ScreenToLonLat(Point(X+DELTA, Y+DELTA));
@ -349,7 +376,11 @@ begin
for i:=0 to gpsList.Count-1 do
if gpsList[i] is TGpsPoint then
with TGpsPoint(gpsList[i]) do
L.Add(Format('%s' + Lineending + ' (lat=%.6f°, lon=%.6f°)', [Name, Lat, Lon]));
L.Add(Format('%s' + Lineending + ' (lat=%.6f°=%s, lon=%.6f°=%s°)', [
Name, Lat, GPSToDMS(Lat), Lon, GPSToDMS(Lon)
]));
//L.Add(Format('%s' + Lineending + ' (lat=%.6f°, lon=%.6f°)', [Name, Lat, Lon]));
GPSPointInfo.Caption := L.Text;
finally
L.Free;
@ -470,6 +501,30 @@ begin
CbLocations.Text := ALocation;
end;
procedure TMainForm.UpdateViewportSize;
begin
InfoViewportWidth.Caption := Format('%.2n %s', [
CalcGeoDistance(
MapView.GetVisibleArea.TopLeft.Lat,
MapView.GetVisibleArea.TopLeft.Lon,
MapView.GetVisibleArea.TopLeft.Lat,
MapView.GetVisibleArea.BottomRight.Lon,
TDistanceUnits(cbDistanceUnits.ItemIndex)
),
cbDistanceUnits.Items[cbDistanceUnits.ItemIndex]
]);
InfoViewportHeight.Caption := Format('%.2n %s', [
CalcGeoDistance(
MapView.GetVisibleArea.TopLeft.Lat,
MapView.GetVisibleArea.TopLeft.Lon,
MapView.GetVisibleArea.BottomRight.Lat,
MapView.GetVisibleArea.TopLeft.Lon,
TDistanceUnits(cbDistanceUnits.ItemIndex)
),
cbDistanceUnits.Items[cbDistanceUnits.ItemIndex]
]);
end;
procedure TMainForm.WriteToIni;
var
ini: TCustomIniFile;

View File

@ -44,6 +44,8 @@ Type
TTileIdArray = Array of TTileId;
TDistanceUnits = (duMeters, duKilometers, duMiles);
{ TMapWindow }
TMapWindow = Record
@ -161,6 +163,13 @@ Type
property OnZoomChange: TNotifyEvent read FOnZoomChange write FOnZoomChange;
end;
function CalcGeoDistance(Lat1, Lon1, Lat2, Lon2: double;
AUnits: TDistanceUnits = duKilometers): double;
function GPSToDMS(Angle: Double): string;
procedure SplitGps(AValue: Double; out ADegs, AMins, ASecs: Double);
implementation
@ -1090,5 +1099,65 @@ begin
end;
//------------------------------------------------------------------------------
procedure SplitGps(AValue: Double; out ADegs, AMins: Double);
begin
AValue := abs(AValue);
AMins := frac(AValue) * 60;
ADegs := trunc(AValue);
end;
procedure SplitGps(AValue: Double; out ADegs, AMins, ASecs: Double);
begin
SplitGps(AValue, ADegs, AMins);
ASecs := frac(AMins) * 60;
AMins := trunc(AMins);
end;
function GPSToDMS(Angle: Double): string;
var
deg, min, sec: Double;
begin
SplitGPS(Angle, deg, min, sec);
Result := Format('%.0f° %.0f'' %.1f"', [deg, min, sec]);
end;
{ Returns the direct distance (air-line) between two geo coordinates
If latitude NOT between -90°..+90° and longitude NOT between -180°..+180°
the function returns -1.
Usage: FindDistance(51.53323, -2.90130, 51.29442, -2.27275, duKilometers);
}
function CalcGeoDistance(Lat1, Lon1, Lat2, Lon2: double;
AUnits: TDistanceUnits = duKilometers): double;
const
raduis_km: double = 6371.0; // generalized radius of earth
var
d_radians: double; // distance in radians
lat1r, lon1r, lat2r, lon2r: double;
begin
// Validate
if (Lat1 < -90.0) or (Lat1 > 90.0) then exit(-1);
if (Lon1 < -180.0) or (Lon1 > 180.0) then exit(-1);
if (Lat2 < -90.0) or (Lat2 > 90.0) then exit(-1);
if (Lon2 < -180.0) or (Lon2 > 180.0) then exit(-1);
// Turn lat and lon into radian measures
lat1r := (PI / 180.0) * Lat1;
lon1r := (PI / 180.0) * Lon1;
lat2r := (PI / 180.0) * Lat2;
lon2r := (PI / 180.0) * Lon2;
// calc
d_radians := arccos(Sin(lat1r) * sin(lat2r) + cos(lat1r) * cos(lat2r) * cos(lon1r - lon2r));
Result := EARTH_RADIUS * d_radians;
case AUnits of
duMeters: ;
duKilometers: Result := Result * 1E-3;
duMiles: Result := Result * 0.62137E-3;
end;
end;
end.