(21-10-18, 11:43 PM)rnmr كتب : جرب هذا

هذا الموقع يحتوي المعادلة بلغة VB.NET
This routine calculates the distance between two points

قمت بتحويله إلى VB6

كود :

Private Sub Command1_Click()
       
   Dim dist As Double
   ' Point1 = 11.111111, 22.222222
   ' Point2 = 77.777777, 88.888888
   ' Unit = "K" ~ kilometers
       
   dist = distance(11.111111, 22.222222, 77.777777, 88.888888, "K") ' K = km
       
   MsgBox FormatNumber(dist) & " KM"

End Sub


':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::                                                                         :::
':::  This routine calculates the distance between two points (given the     :::
':::  latitude/longitude of those points). It is being used to calculate     :::
':::  the distance between two locations using GeoDataSource (TM) prodducts  :::
':::                                                                         :::
':::  Definitions:                                                           :::
':::    South latitudes are negative, east longitudes are positive           :::
':::                                                                         :::
':::  Passed to function:                                                    :::
':::    lat1, lon1 = Latitude and Longitude of point 1 (in decimal degrees)  :::
':::    lat2, lon2 = Latitude and Longitude of point 2 (in decimal degrees)  :::
':::    unit = the unit you desire for results                               :::
':::           where: 'M' is statute miles (default)                         :::
':::                  'K' is kilometers                                      :::
':::                  'N' is nautical miles                                  :::
':::                                                                         :::
':::  Worldwide cities and other features databases with latitude longitude  :::
':::  are available at https://www.geodatasource.com                          :::
':::                                                                         :::
':::  For enquiries, please contact sales@geodatasource.com                  :::
':::                                                                         :::
':::  Official Web site: https://www.geodatasource.com                        :::
':::                                                                         :::
':::              GeoDataSource.com (C) All Rights Reserved 2017             :::
':::                                                                         :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
Public Function distance(ByVal lat1 As Double, ByVal lon1 As Double, ByVal lat2 As Double, ByVal lon2 As Double, ByVal unit As String) As Double
   Dim theta As Double
   theta = lon1 - lon2
   Dim dist As Double
   dist = Sin(deg2rad(lat1)) * Sin(deg2rad(lat2)) + Cos(deg2rad(lat1)) * Cos(deg2rad(lat2)) * Cos(deg2rad(theta))
   dist = ArcCos(dist)
   dist = rad2deg(dist)
   dist = dist * 60 * 1.1515
   If unit = "K" Then
       dist = dist * 1.609344
   ElseIf unit = "N" Then
       dist = dist * 0.8684
   End If
   distance = dist
End Function
Public Function ArcCos(ByVal x As Double) As Double
   ArcCos = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1)
End Function
Public Function ArcSin(ByVal x As Double) As Double
   ArcSin = Atn(x / Sqr(-x * x + 1))
End Function
Public Function Pi() As Double
 Pi = 4 * Atn(1#)
End Function
Private Function deg2rad(ByVal deg As Double) As Double
   deg2rad = (deg * Pi / 180#)
End Function
Private Function rad2deg(ByVal rad As Double) As Double
   rad2deg = rad / Pi * 180#
End Function

---

مع ملاحظة أن المسافة تقاس بشكل مستقيم بين النقطتين

(22-10-18, 12:45 AM)rnmr كتب : جرب هذا


لعل في البحث بجوجل يتم الحصول على كود أفضل وأدق من هذا

وأخشى أنك تقارن السير بالسيارة مثلا بنتيجة هذا الكود،
فبالطبع سيكون هناك فارق، لأن الكود يسحسب المسافة بخط مستقيم.

بالتوفيق