⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 一次换乘.bas

📁 vb开发的公交查询系统
💻 BAS
字号:
Attribute VB_Name = "Module5"
Option Explicit
'一次换乘直接方式的中间换乘点
Public UStation(1 To 20) As String
Public UTotal As Integer
'一次换乘非直接方式的中间下车点、步行后再上车点
Public UMStation(1 To 30) As String
Public UTransfer(1 To 30) As String
Public UTot As Integer



'直接一次换乘(第一、第二趟公交车有公共站点—换乘不需要步行)
Public Sub TransferDirect(Bus1 As String, Bus2 As String, _
                          Station1 As String, Station2 As String)
Dim i, j, k, m As Integer
Dim SameStationTotal As Integer
Dim SameStation(1 To 10) As String
Dim Flag1, Flag2 As Boolean


'初始化
UTotal = 0
For i = 1 To 20
    UStation(i) = ""
Next i
'UTot = 0
'For i = 1 To 30
    'UMStation(i) = ""
    'UTransfer(i) = ""
'Next i

m = 1
For i = 0 To 1
    For j = 0 To 1
        Call CompareStrN(CXBusnumStationnumsStr(Bus1, i), _
                         CXBusnumStationnumsStr(Bus2, j))
        SameStationTotal = Total
        For k = 1 To SameStationTotal
            SameStation(k) = SameNum(k)
        Next k
        For k = 1 To SameStationTotal
            Flag1 = Child(CXBusnumStationnumsStr(Bus1, i), _
                          Station1, SameStation(k))
            Flag2 = Child(CXBusnumStationnumsStr(Bus2, j), _
                          SameStation(k), Station2)
            If (Flag1 And Flag2) Then
                UStation(m) = SameStation(k)
                UTotal = m
                m = m + 1
                '--------------------------------------------------------------
                'Exit Sub   '使有好几个重合站点的两条公交线路仅以一个站点为中转站 _
                             此不合理性在于:不同路线的公交车在两站点间运行的速度 _
                             不一致,而且发车频率也不一样
                '--------------------------------------------------------------
            End If
            
        Next k
    Next j
Next i


End Sub



'非直接一次换乘(在一个站点下第一趟车后,步行一段,
'                再在另一公交站点上第二趟公交车)
Public Sub TransferNDirect(Bus1 As String, Bus2 As String, _
                           Station1 As String, Station2 As String)
Dim i, j, m As Integer
Dim PTotal As Integer
Dim P(1 To 30) As String
Dim CircleStr As String
Dim MidStation As String

'初始化
'UTotal = 0
'For i = 1 To 20
    'UStation(i) = ""
'Next i
UTot = 0
For i = 1 To 30
    UMStation(i) = ""
    UTransfer(i) = ""
Next i

m = 1
Call BackStation(Bus1, Station1)
PTotal = UPointTotal
For i = 1 To PTotal
    P(i) = UPoint(i)
Next i
For i = 1 To PTotal
    CircleStr = Mid(CXCircleStationStr(P(i)), Len(P(i)) + 1, _
                    Len(CXCircleStationStr(P(i))))          '除去其本身站点号
    For j = 0 To 1
        MidStation = CompareStr1(CircleStr, CXBusnumStationnumsStr(Bus2, j))
        If MidStation <> "" Then
           If Child(CXBusnumStationnumsStr(Bus2, j), _
                    MidStation, Station2) Then
              UMStation(m) = P(i)
              UTransfer(m) = MidStation
              UTot = m
              m = m + 1
              '---------------------------------------------------------------
              'Exit Sub        '避免两条公交线路多站点重合造成的多条换乘方式(同上)
              '---------------------------------------------------------------
           End If
        End If
    Next j
Next i
                 
                           
End Sub


⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -