(公交换乘)twicetransfer.bas

vb开发的公交查询系统

Attribute VB_Name = "ModuleTwiceTransfer"



'二次换乘方式的求取
Public Sub TwiceTransfer(StationNum1 As Integer, StationNum2 As Integer)

    Dim i, j, k, m, n, g, q, w As Integer
    Dim tol1 As Integer
    Dim tol2 As Integer
    Dim tol3 As Integer
    Dim tol4 As Integer
    Dim toln1(1 To 30), toln2(1 To 30), toln3(1 To 30) As String
    Dim tolnum1(1 To 30) As String
    Dim tolnum2(1 To 30) As String
    Dim tolnum3(1 To 30) As String
    Dim Fstr, Bstr As String
    
    Dim Bus1FX As Integer
    Dim Bus2FX As Integer
    Dim Bus3FX As Integer
    
    Dim BPTotal As Integer
    Dim BP(1 To 30) As String
    Dim FPTotal As Integer
    Dim FP(1 To 30) As String
    Dim SameBusTotal As Integer
    Dim SameBus(1 To 20) As String
    
    Dim StartCircle(1 To 10) As String               '起点站周围站点
    Dim EndCircle(1 To 10) As String                 '终点站周围站点
    Dim StartBus(1 To 10) As String                  '在起点及周围站点可以乘坐的公交车次
    Dim EndBus(1 To 10) As String                    '在终点及周围站点可以乘坐的公交车次
    Dim XStransSStation(1 To 100) As String          '各种二次换乘到达方式的地图表述用的公交站点号
    Dim XStransSTotal As Integer                     '总共要地图显示的公交站点个数
    
    Dim upStation(1 To 20) As String                 '上车点
    Dim Transfer1(1 To 20) As String                 '第一个换乘点
    Dim Transfer2(1 To 20) As String                 '第二个换乘点
    Dim Transfer3(1 To 20) As String                 '第三个换乘点
    Dim downStation(1 To 20) As String               '下车点
    Dim Bus1(1 To 20) As String                      '乘坐的第一趟公交车
    Dim Bus2(1 To 20) As String                      '乘坐的第二趟公交车
    Dim Bus3(1 To 20) As String                      '乘坐的第三趟公交车
    Dim TransTotal As Integer                        '二次换乘方式的总个数
    Dim CXUseString(1 To 20) As String
    
    Dim Distance1(1 To 30), Distance2(1 To 30), Distance3(1 To 30), Distance(1 To 30) As Single
    
    Set db = DBEngine.OpenDatabase("C:\llxxqq\GongJiao\GJResult.mdb")
    Set rs1 = db.OpenRecordset("WZtemp", dbOpenTable)
    Set rs2 = db.OpenRecordset("DTtemp", dbOpenTable)
        
     '清除原有数据表
    If ChkValue = 4 Then
        If rs1.RecordCount > 0 Then
            rs1.MoveFirst
            For i = 1 To rs1.RecordCount
                rs1.Delete
                rs1.MoveNext
            Next i
        End If
        If rs2.RecordCount > 0 Then
            For i = 1 To rs2.RecordCount
                rs2.MoveFirst
                rs2.Delete
            Next i
        End If
    End If
    
    '确定输入的起终点周围可上车的公交站点号
    Call Separate(CXCircleStationStr(StartNum))
    tol1 = Lnum
    For i = 1 To tol1
        StartCircle(i) = Mynum(i)
    Next i
    Call Separate(CXCircleStationStr(EndNum))
    tol2 = Lnum
    For i = 1 To tol2
        EndCircle(i) = Mynum(i)
    Next i
            
    '初始化
    
    'If ChkValue = 4 Then
        'MyfrmMain.Text3.Text = ""
    'Else
        'MyfrmMain.Text3.Text = MyfrmMain.Text3.Text & vbCrLf & vbCrLf
    'End If
    
    w = 1
    For i = 1 To tol1
        For j = 1 To tol2
            Call Separate(StationnumBusnumsStr(StartCircle(i)))
            tol3 = Lnum
            For k = 1 To tol3
                StartBus(k) = Mynum(k)
            Next k
            Call Separate(StationnumBusnumsStr(EndCircle(j)))
            tol4 = Lnum
            For k = 1 To tol4
                EndBus(k) = Mynum(k)
            Next k
            
            For m = 1 To tol3
                For n = 1 To tol4
                    '排除直接到达方式
                    If StartBus(m) <> EndBus(n) Then
                       '调用“后向站点”模块，求取在一个站点上车后可到达的公交站点
                       Call BackStation(StartBus(m), StartCircle(i))
                       BPTotal = UPointTotal
                       For k = 1 To BPTotal
                           BP(k) = UPoint(k)
                       Next k
                       '调用“前向站点”模块，求取要到达一个站点可上车的公交站点
                       Call FrontStation(EndBus(n), EndCircle(j))
                       FPTotal = UPointTotal
                       For k = 1 To FPTotal
                           FP(k) = UPoint(k)
                       Next k
                       
                       For g = 1 To BPTotal
                           For q = 1 To FPTotal
                           
                           '避免中间换乘点为所要到达的终点----------(后加)-----------
                                If BP(g) <> CStr(EndNum) And FP(q) <> CStr(StartNum) Then
                           '-------------------------------------------------------
                                    If BP(g) <> FP(q) Then
                                       '求取第二趟公交车
                                       '某一后向站点可用的公交车===某一前项站点可用的公交车
                                       Call CompareStrN(StationnumBusnumsStr(BP(g)), _
                                                        StationnumBusnumsStr(FP(q)))
                                       SameBusTotal = Total
                                       For k = 1 To SameBusTotal
                                           SameBus(k) = SameNum(k)
                                       Next k
                                       
                                       For k = 1 To SameBusTotal
                                           If w <= WantNum Then
                                              If SameBus(k) <> StartBus(m) And SameBus(k) <> EndBus(n) Then
                                                 upStation(w) = StartCircle(i)
                                                 Bus1(w) = StartBus(m)
                                                 Transfer1(w) = BP(g)
                                                 Bus2(w) = SameBus(k)
                                                 Transfer2(w) = FP(q)
                                                 Bus3(w) = EndBus(n)
                                                 downStation(w) = EndCircle(j)
                                                 TransTotal = w
                                                 w = w + 1
                                              End If
                                           End If
                                       Next k
                                    End If
                                End If   '------------------------------------------------
                           Next q
                       Next g
                    End If
                Next n
            Next m
        Next j
    Next i
    
    
    jl = rs1.RecordCount
     '地图显示可用的二次换乘出行方式的乘车情况
    MyfrmMain.Text3.Text = MyfrmMain.Text3.Text & vbCrLf & vbCrLf & vbCrLf
    For i = 1 To TransTotal
        Call Abstract2(Bus1(i), upStation(i), Transfer1(i))
        tol1 = Cnum                                '模块返回值的存储
        For j = 1 To tol1
            tolnum1(j) = ChildNum(j)
        Next j
        Bus1FX = Direction
        Call Abstract2(Bus2(i), Transfer1(i), Transfer2(i))
        tol2 = Cnum                                '模块返回值的存储
        For j = 1 To tol2
            tolnum2(j) = ChildNum(j)
        Next j
        Bus2FX = Direction
        Call Abstract2(Bus3(i), Transfer2(i), downStation(i))
        tol3 = Cnum                                '模块返回值的存储
        For j = 1 To tol3
            tolnum3(j) = ChildNum(j)
        Next j
        Bus3FX = Direction
        If tol1 > 0 And tol2 > 0 And tol3 > 0 Then
            Call TotalImpedence(Bus1(i), Bus1FX, tolnum1, tol1)