mdudistance.bas

师兄做的一个利用VB结合mapx组件做的超市查询小系统

Attribute VB_Name = "MduDistance"

Const PI = 3.1415927
Const m_R = (6378137 + 6356752) / 2

Dim angLatA As Double
Dim angLatB As Double
Dim angLonA As Double
Dim angLonB As Double
Dim angAB As Double


Public Function GetDistance(ByVal X1 As Single, ByVal Y1 As Single, ByVal X2 As Single, ByVal Y2 As Single) As Single
    
    Dim tempV As Double
    Dim tempD As Double

    angLatA = X1 / 180 * PI
    angLonA = Y1 / 180 * PI
    angLatB = X2 / 180 * PI
    angLonB = Y2 / 180 * PI


   
    tempV = VBA.Cos(angLatA) * VBA.Cos(angLatB) * VBA.Cos(angLonB - angLonA) + VBA.Sin(angLatA) * VBA.Sin(angLatB)

    Select Case tempV
       Case 1
           tempD = 0

       Case -1
           tempD = m_R * PI
       Case Else
            angAB = VBA.Atn(-tempV / VBA.Sqr(-tempV * tempV + 1)) + 2 * VBA.Atn(1)
            tempD = m_R * angAB
    End Select

    tempD = tempD / 1000
    GetDistance = tempD
End Function


Public Function GetX(ByVal X1 As Double, ByVal Y1 As Double) As Double
    Dim nodeX As Double
    
    angLatA = 0
    angLonA = 0
    
    angLatA = X1 / 180 * PI
    angLonA = Y1 / 180 * PI
    
    nodeX = m_R * Cos(angLatA) * Cos(angLonA)
    GetX = nodeX
End Function

Public Function GetY(ByVal X1 As Double, ByVal Y1 As Double) As Double
    Dim nodeY As Double
    
    angLatA = 0
    angLonA = 0
    
    angLatA = X1 / 180 * PI
    angLonA = Y1 / 180 * PI
    
    nodeX = m_R * Cos(angLatA) * Sin(angLonA)
    GetY = nodeY
End Function