You've already forked lazarus-ccr
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:
@ -56,7 +56,7 @@ end;
|
||||
|
||||
procedure TGPSListViewer.Populate;
|
||||
const
|
||||
GPS_FORMAT = '0.000000';
|
||||
GPS_FORMAT = '0.00000°';
|
||||
var
|
||||
i: Integer;
|
||||
item: TListItem;
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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.
|
||||
|
||||
|
Reference in New Issue
Block a user