(公交换乘)oncetransfer.bas

vb开发的公交查询系统

                    rs2.Fields("公交站点名") = XSStationName(Val(XStransStation(j)))
                    rs2.Fields("经度") = Longitude(Val(XStransStation(j)))
                    rs2.Fields("纬度") = Latitude(Val(XStransStation(j)))
                    rs2.Update
                    rs2.Bookmark = rs2.LastModified
                Next j
                jl = jl + 1
            'End If
            '=========================================
        End If
    Next i
        
        
    If rs2.RecordCount = 0 Then
        jl = 0
    Else
        rs2.MoveLast
        jl = rs2.Fields("序号")
    End If
    '地图显示可用的一次非直接换乘出行方式的乘车情况
    For i = 1 To NDTransTotal
        Call Abstract2(NDTransBus1(i), NDupStation(i), NDMiddownStation(i))
        NDSubNum1tol = Cnum
        For j = 1 To NDSubNum1tol
            NDSubNum1(j) = ChildNum(j)
        Next j
         Bus1FX = Direction
        Call Abstract2(NDTransBus2(i), NDTransferStation(i), NDdownStation(i))
        NDSubNum2tol = Cnum
        For j = 1 To NDSubNum2tol
            NDSubNum2(j) = ChildNum(j)
        Next j
        Bus2FX = Direction
        
        If NDSubNum1tol > 0 And NDSubNum2tol > 0 Then
            Call TotalImpedence(DTransBus1(i), Bus1FX, DSubNum1, DSubNum1tol)
            NDistance1(i) = Impedence
            Call TotalImpedence(DTransBus2(i), Bus2FX, DSubNum2, DSubNum2tol)
            NDistance2(i) = Impedence
        
            If StartNum > 1000 Then
                Fstr = CompareStr1(SamenameStationStr(StartNum), _
                                    XSCircleStationStr(NDSubNum1(1)))
            Else
                Fstr = CStr(StartNum)
            End If
            If Fstr <> NDSubNum1(1) Then              '上车站不是起点公交车站
                XStransNStation(1) = Fstr
                For j = 2 To NDSubNum1tol + 1
                    XStransNStation(j) = NDSubNum1(j - 1)
                Next j
                NDistance1(i) = NDistance1(i) + BXDistance
                '没有中间重合站点（从下车点步行至第二趟车的上车点）
                For j = 1 To NDSubNum2tol
                    XStransNStation(NDSubNum1tol + 1 + j) = NDSubNum2(j)
                Next j
                XStransNTotal = NDSubNum1tol + NDSubNum2tol + 1
                If EndNum > 1000 Then            '输入的终点站是同名站点合并后的公交站点名
                '调用字符串比较函数——终点
                    Bstr = CompareStr1(SamenameStationStr(EndNum), _
                                        XSCircleStationStr(NDSubNum2(NDSubNum2tol)))
                Else
                    Bstr = CStr(EndNum)
                End If
                If Bstr <> XStransNStation(XStransNTotal) Then           '下车站不是终点公交车站
                    XStransNTotal = XStransNTotal + 1
                    XStransNStation(XStransNTotal) = Bstr
                    NDistance2(i) = NDistance2(i) + BXDistance
                End If
                
            Else
                For j = 1 To NDSubNum1tol
                    XStransNStation(j) = NDSubNum1(j)
                Next j
                For j = 1 To NDSubNum2tol
                    XStransNStation(NDSubNum1tol + j) = NDSubNum2(j)
                Next j
                XStransNTotal = NDSubNum1tol + NDSubNum2tol
                If EndNum > 1000 Then
                   Bstr = CompareStr1(SamenameStationStr(EndNum), _
                                      XSCircleStationStr(NDSubNum2(NDSubNum2tol)))
                Else
                   Bstr = CStr(EndNum)
                End If
                If Bstr <> XStransNStation(XStransNTotal) Then
                   XStransNTotal = XStransNTotal + 1
                   XStransNStation(XStransNTotal) = Bstr
                   NDistance2(i) = NDistance2(i) + BXDistance
                End If
            End If
            '有中间换乘的步行距离
            NDistance(i) = NDistance1(i) + NDistance2(i) + BXDistance
            
            'For j = 1 To XStransNTotal
                 'MyfrmMain.Text3.Text = MyfrmMain.Text3.Text & XSStationName(Val(XStransNStation(j))) & vbTab
            'Next j
            'MyfrmMain.Text3.Text = MyfrmMain.Text3.Text & vbCrLf & NDistance(i) & vbCrLf
      
            '==============================================
            'If NDistance(i) < 1000 Then
                For j = 1 To XStransNTotal
                    rs2.AddNew
                    rs2.Fields("序号") = 1 + jl
                    rs2.Fields("公交站点名") = XSStationName(Val(XStransNStation(j)))
                    rs2.Fields("经度") = Longitude(Val(XStransNStation(j)))
                    rs2.Fields("纬度") = Latitude(Val(XStransNStation(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 DTransTotal
        Call Abstract1(DTransBus1(i), DupStation(i), DTransferStation(i))
        DSubNum1tol = Cnum
        For j = 1 To DSubNum1tol
            DSubNum1(j) = ChildNum(j)
        Next j
        Call Abstract1(DTransBus2(i), DTransferStation(i), DdownStation(i))
        DSubNum2tol = Cnum
        For j = 1 To DSubNum2tol
            DSubNum2(j) = ChildNum(j)
        Next j
         
        If DSubNum1tol > 0 And DSubNum2tol > 0 Then
      
            'If MyfrmMain.Text3.Text = "" Then
                'MyfrmMain.Text3.Text = "起终点间可用的一次换乘出行方式有：" & vbCrLf & vbCrLf
            'ElseIf ChkValue <> 2 Then
                'MyfrmMain.Text3.Text = MyfrmMain.Text3.Text & "起终点间可用的一次换乘出行方式有：" & vbCrLf & vbCrLf
            'End If
      
            For j = 1 To DSubNum1tol
                DCXUsefulStr1(i) = DCXUsefulStr1(i) & CXStationName(DSubNum1(j)) & "、"
            Next j
            '第一趟车的下车站点===第二趟车的上车站点（故下一行从j=2开始循环）
            For j = 2 To DSubNum2tol
                DCXUsefulStr2(i) = DCXUsefulStr2(i) & CXStationName(DSubNum2(j)) & "、"
            Next j
            DCXUsefulStr(i) = DCXUsefulStr1(i) & DCXUsefulStr2(i)
           
            If CStr(StartNum) <> DupStation(i) Then       '上车点不是起点（需要先步行一段）
               DCXUsefulStr(i) = StartName & "、" & DCXUsefulStr(i)
            End If
            If CStr(EndNum) <> DdownStation(i) Then       '下车点不是终点
               DCXUsefulStr(i) = DCXUsefulStr(i) & "、" & EndName
            End If
            'MyfrmMain.Text3.Text = MyfrmMain.Text3.Text & "请乘" & DTransBus1(i) & "次车，在" & CXStationName(DTransferStation(i)) _
                        & "站换乘" & DTransBus2(i) & "次车" & vbCrLf & DCXUsefulStr(i) & vbCrLf & vbCrLf
                        
            '====================================================
            'If Distance(i) < 1000 Then
               rs1.AddNew
               rs1.Fields("序号") = jl
               rs1.Fields("出行方式") = "一次直接换乘方式"
               rs1.Fields("出行方式具体描述") = "请乘" & DTransBus1(i) & "路车,在" & _
                                               CXStationName(DSubNum1(DSubNum1tol)) & _
                                               "站再换乘" & DTransBus2(i) & "路车" _
                                                & "-----" & DCXUsefulStr(i)
               rs1.Fields("路阻值") = Distance(i)
               rs1.Update
               rs1.Bookmark = rs1.LastModified
               jl = jl + 1
    
               TDbool = True
            'End If
            '=================================================
        End If
    Next i
    
    'If MyfrmMain.Text3.Text = "" Then
        'MyfrmMain.Text3.Text = "起终点间不可通过一次换乘方式到达！"
    'End If
    
    
    
    
    '文字显示可用的一次非直接换乘出行方式的乘车情况
    jl = rs1.RecordCount + 1
    For i = 1 To NDTransTotal
        Call Abstract1(NDTransBus1(i), NDupStation(i), NDMiddownStation(i))
        NDSubNum1tol = Cnum
        For j = 1 To NDSubNum1tol
            NDSubNum1(j) = ChildNum(j)
        Next j
        Call Abstract1(NDTransBus2(i), NDTransferStation(i), NDdownStation(i))
        NDSubNum2tol = Cnum
        For j = 1 To NDSubNum2tol
            NDSubNum2(j) = ChildNum(j)
        Next j

        If NDSubNum1tol > 0 And NDSubNum2tol > 0 Then
            'If MyfrmMain.Text3.Text = "" Then
                'MyfrmMain.Text3.Text = "起终点间可用的一次换乘出行方式有：" & vbCrLf & vbCrLf
            'End If
            For j = 1 To NDSubNum1tol
                NDCXUsefulStr1(i) = NDCXUsefulStr1(i) & CXStationName(NDSubNum1(j)) & "、"
            Next j
            '第一趟车的下车站点<>第二趟车的上车站点（故下一行从j=1开始循环）
            For j = 1 To NDSubNum2tol
                NDCXUsefulStr2(i) = NDCXUsefulStr2(i) & CXStationName(NDSubNum2(j)) & "、"
            Next j
            flagstr = CXStationName(NDSubNum1(NDSubNum1tol))
            NDCXUsefulStr(i) = NDCXUsefulStr1(i) & NDCXUsefulStr2(i)
            
            If CStr(StartNum) <> NDupStation(i) Then       '上车点不是起点（需要先步行一段）
                NDCXUsefulStr(i) = StartName & "、" & NDCXUsefulStr(i)
            End If
            If CStr(EndNum) <> NDdownStation(i) Then       '下车点不是终点
                NDCXUsefulStr(i) = NDCXUsefulStr(i) & "、" & EndName
            End If
            'MyfrmMain.Text3.Text = MyfrmMain.Text3.Text & "请乘" & NDTransBus1(i) & "次车，在" _
                        & CXStationName(NDMiddownStation(i)) & "站下车，步行至" _
                        & CXStationName(NDTransferStation(i)) & "站换乘" & NDTransBus2(i) _
                        & "次车" & vbCrLf & NDCXUsefulStr(i) & vbCrLf & vbCrLf
        
            '==================================================
            'If NDistance(i) < 1000 Then
               rs1.AddNew
               rs1.Fields("序号") = jl
               rs1.Fields("出行方式") = "一次非直接换乘方式"
               rs1.Fields("出行方式具体描述") = "请乘" & NDTransBus1(i) & "路车,在" & _
                                             CXStationName(NDSubNum1(NDSubNum1tol)) & _
                                             "站下车,而后在" & CXStationName(NDSubNum2(NDSubNum2tol)) _
                                             & "站再换乘" & NDTransBus2(i) & "路车" _
                                             & "-----" & NDCXUsefulStr(i)
               rs1.Fields("路阻值") = NDistance(i)
               rs1.Update
               rs1.Bookmark = rs1.LastModified
               jl = jl + 1
        
               TNDbool = True
            'End If
            '===========================================
        End If
    Next i
    
    If TDbool = False And TNDbool = False Then
        Trans1Bool = False
        If ChkValue = 2 Or ChkValue = 6 Then
            MyfrmMain.Text3.Text = vbCrLf & "起终点间不可通过一次换乘方式到达！"
        Else
            MyfrmMain.Text3.Text = MyfrmMain.Text3.Text & vbCrLf & _
                                          vbCrLf & "起终点间不可通过一次换乘方式到达！"
        End If
    Else
        Trans1Bool = True
    End If
    
End Sub