[السيد الغالي]

(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

---

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

كل الشكر والتقدير لك اخي العزيز . لكن تبقى مشكلة الدقة . في السافات البعيدة تكون الدقة مقبولة نوعا ما اما في المسافات القصيرة(اقل من 1كم ) مثلا هناك فرق كبير جدا . اكرر شكري لك وتقديري