路阻求取(一车,两站点).bas

来自「vb开发的公交查询系统」· BAS 代码 · 共 87 行

Attribute VB_Name = "Module7"

Public NearestStationNum As String




Public Sub TotalImpedence(Bush As String, Busfx As Integer, _
                          Stationxl() As String, Stationgs As Integer)
'Bush--公交车号；Busfx--公交车方向；Stationxl--公交站点序列；Stationgs--公交站点个数
    
    Dim i As Integer
   
    Impedence = 0
    Select Case Funit
        Case "Distance"
            For i = 1 To Stationgs - 1
                Impedence = Impedence + ImpedenceDistance(Bush, Busfx, Stationxl(i))
            Next i
            
        Case "Time"
            For i = 1 To Stationgs - 1
                Impedence = Impedence + ImpedenceTime(Bush, Busfx, Stationxl(i))
            Next i
          
        Case "Cost"
            For i = 1 To Stationgs - 1
                Impedence = Impedence + ImpedenceCost(Bush, Busfx, Stationxl(i))
            Next i
                      
        Case "Syn"
            For i = 1 To Stationgs - 1
                Impedence = Impedence + ImpedenceSyn(Bush, Busfx, Stationxl(i))
            Next i
          
    End Select

    
End Sub


'求两站点之间的距离（米）
Public Function MidL(Station1 As String, Station2 As String) As Single

    Dim LL As Single
       
    If XSStationName(Station1) = XSStationName(Station2) Then   '上下车的转乘站点为同一个
        MidL = 0
    Else
        LL = Sqr((Longitude(Val(Station1)) * 3600 - Longitude(Val(Station2)) * 3600) ^ 2 + _
                 (Latitude(Val(Station1)) * 3600 - Latitude(Val(Station2)) * 3600) ^ 2)
        If LL <= 3 Then                              '上下车的转乘站点为相距在100米之内的两个站点
            MidL = 100 / 1000
        Else                                         '上下车的转乘站点为相距较远
            MidL = LL * 100 / 3 / 1000 + 1000        '以公里为单位(表示两点间不可步行换乘,"+1000"是附加项)
        End If
    End If

End Function


'求距离给定的某一点最近的公交站点
Public Function NearestStation(x As Double, y As Double)
    
    Dim i As Integer
    Dim MinDis As Single
    Dim Dis As Single
    Dim str As String
    
    MinDis = 1000
    For i = 1 To TotalStation
        Dis = Sqr((Longitude(i) * 3600 - x * 3600) ^ 2 + _
                 (Latitude(i) * 3600 - y * 3600) ^ 2)
        If MinDis > Dis Then
            MinDis = Dis
            NearestStationNum = CStr(i) '找到的是XS(显示)用的公交站点
        End If
    Next i
    str = "*," & NearestStationNum & ",*"
    For i = 1000 To 2000
        If (SamenameStationStr(i) Like str) Then
            NearestStationNum = CStr(i) '找到的是CX(查询)用的公交站点
        End If
    Next i
    
End Function