(公交换乘)twicetransfer.bas

vb开发的公交查询系统

            Distance1(i) = Impedence
            Call TotalImpedence(Bus2(i), Bus2FX, tolnum2, tol2)
            Distance2(i) = Impedence
            Call TotalImpedence(Bus3(i), Bus3FX, tolnum3, tol3)
            Distance3(i) = Impedence
       
            If StartNum > 1000 Then                '输入的起点站是同名站点合并后的公交站点名
            '调用字符串比较函数—起点的同名站点序列与上车站点的周围站点序列
            '确定用于地图显示的起点站的确切公交站点号—Fstr
                Fstr = CompareStr1(SamenameStationStr(StartNum), _
                                  XSCircleStationStr(tolnum1(1)))
            Else
                Fstr = CStr(StartNum)
            End If
            If Fstr <> tolnum1(1) Then              '上车站不是起点公交车站
                XStransSStation(1) = Fstr
                For j = 2 To tol1 + 1                '起点站j=1
                    XStransSStation(j) = tolnum1(j - 1)
                Next j
                XStransSTotal = tol1 + 1
                Distance1(i) = Distance1(i) + BXDistance
                '有重合站点
                For j = 2 To tol2
                    XStransSStation(XStransSTotal + j - 1) = tolnum2(j)
                Next j
                XStransSTotal = tol1 + tol2
                '有重合站点
                For j = 2 To tol3
                    XStransSStation(XStransSTotal + j - 1) = tolnum3(j)
                Next j
                XStransSTotal = tol1 + tol2 + tol3 - 1
                
                If EndNum > 1000 Then            '输入的终点站是同名站点合并后的公交站点名
                '调用字符串比较函数——确切终点—Bstr
                    Bstr = CompareStr1(SamenameStationStr(EndNum), _
                                      XSCircleStationStr(XStransSStation(XStransSTotal)))
                Else
                    Bstr = CStr(EndNum)
                End If
                If Bstr <> XStransSStation(XStransSTotal) Then           '下车站不是终点公交车站
                    XStransSTotal = XStransSTotal + 1
                    XStransSStation(XStransSTotal) = Bstr
                    Distance3(i) = Distance3(i) + BXDistance
                End If
              
            Else
                For j = 1 To tol1
                    XStransSStation(j) = tolnum1(j)
                Next j
                XStransSTotal = tol1
             
                For j = 2 To tol2
                    XStransSStation(XStransSTotal + j - 1) = tolnum2(j)
                Next j
                XStransSTotal = tol1 + tol2 - 1
           
                For j = 2 To tol3
                    XStransSStation(XStransSTotal + j - 1) = tolnum3(j)
                Next j
                XStransSTotal = tol1 + tol2 + tol3 - 2
                
                If EndNum > 1000 Then            '输入的终点站是同名站点合并后的公交站点名
                '调用字符串比较函数——终点
                    Bstr = CompareStr1(SamenameStationStr(EndNum), _
                                      XSCircleStationStr(XStransSStation(XStransSTotal)))
                Else
                    Bstr = CStr(EndNum)
                End If
                If Bstr <> XStransSStation(XStransSTotal) Then           '下车站不是终点公交车站
                    XStransSTotal = XStransSTotal + 1
                    XStransSStation(XStransSTotal) = Bstr
                    Distance3(i) = Distance3(i) + BXDistance
                End If
            End If
            Distance(i) = Distance1(i) + Distance2(i) + Distance3(i) _
                                  + MidL(tolnum1(tol1), tolnum2(1)) _
                                  + MidL(tolnum2(tol2), tolnum3(1))
           
            'For j = 1 To XStransSTotal
                'MyfrmMain.Text3.Text = MyfrmMain.Text3.Text & XSStationName(Val(XStransSStation(j))) & vbTab
            'Next j
            'MyfrmMain.Text3.Text = MyfrmMain.Text3.Text & vbCrLf & Distance(i) & vbCrLf
            
            '================================================
            'If Distance(i) < 1000 Then
                For j = 1 To XStransSTotal
                    rs2.AddNew
                    rs2.Fields("序号") = 1 + jl
                    rs2.Fields("公交站点名") = XSStationName(Val(XStransSStation(j)))
                    rs2.Fields("经度") = Longitude(Val(XStransSStation(j)))
                    rs2.Fields("纬度") = Latitude(Val(XStransSStation(j)))
                    rs2.Update
                    rs2.Bookmark = rs2.LastModified
                Next j
                jl = jl + 1
           'End If
           '================================================
        End If
    Next i

    
    jl = rs1.RecordCount + 1
    '文字显示可用的二次换乘出行方式的乘车情况
    For i = 1 To TransTotal
        Call Abstract1(Bus1(i), upStation(i), Transfer1(i))
        tol1 = Cnum                                '模块返回值的存储
        For j = 1 To tol1
            toln1(j) = ChildNum(j)
        Next j
        Call Abstract1(Bus2(i), Transfer1(i), Transfer2(i))
        tol2 = Cnum                                '模块返回值的存储
        For j = 1 To tol2
            toln2(j) = ChildNum(j)
        Next j
        Call Abstract1(Bus3(i), Transfer2(i), downStation(i))
        tol3 = Cnum                                '模块返回值的存储
        For j = 1 To tol3
            toln3(j) = ChildNum(j)
        Next j
        If tol1 > 0 And tol2 > 0 And tol3 > 0 Then
      
             'If MyfrmMain.Text3.Text = "" Then
                 'MyfrmMain.Text3.Text = "起终点间可用的二次换乘出行方式有：" & vbCrLf & vbCrLf
             'ElseIf ChkValue <> 4 Then
                 'MyfrmMain.Text3.Text = MyfrmMain.Text3.Text & "起终点间可用的二次换乘出行方式有：" & vbCrLf & vbCrLf
             'End If
    
             If toln1(1) <> CStr(StartNum) Then
                CXUseString(i) = StartName & "、"
             Else
                CXUseString(i) = ""
             End If
             For j = 1 To tol1
                 CXUseString(i) = CXUseString(i) & CXStationName(Val(toln1(j))) & "、"
             Next j
             '有重合站点
             For j = 2 To tol2
                 CXUseString(i) = CXUseString(i) & CXStationName(Val(toln2(j))) & "、"
             Next j
             '有重合站点
             For j = 2 To tol3
                 CXUseString(i) = CXUseString(i) & CXStationName(Val(toln3(j))) & "、"
             Next j
             If toln3(tol3) <> CStr(EndNum) Then
                CXUseString(i) = CXUseString(i) & EndName
             End If
             
             'CXUseString(i) = "乘坐" & Bus1(i) & "次车" & "在" & CXStationName(Transfer1(i)) & "站换乘" _
                            & Bus2(i) & "次车" & "到" & CXStationName(Transfer2(i)) & "站再换乘" & Bus3(i) _
                            & "次车" & vbCrLf & CXUseString(i)
             'MyfrmMain.Text3.Text = MyfrmMain.Text3.Text & CXUseString(i) & vbCrLf & vbCrLf & vbCrLf
            
            '============================================
            'If Distance(i) < 1000 Then
                rs1.AddNew
                rs1.Fields("序号") = jl
                rs1.Fields("出行方式") = "二次换乘方式"
                rs1.Fields("出行方式具体描述") = "请乘" & Bus1(i) & "路车,在" & _
                                               CXStationName(Val(toln1(tol1))) & _
                                               "站先换乘" & Bus2(i) & "路车,而后在" & _
                                               CXStationName(Val(toln2(tol2))) & _
                                               "站再换乘" & Bus3(i) & "路车-----" & CXUseString(i)
                rs1.Fields("路阻值") = Distance(i)
                rs1.Update
                rs1.Bookmark = rs1.LastModified
                jl = jl + 1
    
                Trans2Bool = True
            'End If
            '===============================================
       End If
    Next i
                       
    If Trans2Bool = False Then
        If ChkValue = 4 Then
            MyfrmMain.Text3.Text = "起终点间不可通过二次换乘方式到达！"
        Else
            MyfrmMain.Text3.Text = MyfrmMain.Text3.Text & vbCrLf & _
                                           "起终点间不可通过二次换乘方式到达！"
        End If
   End If
    
   
End Sub