frmmain(主窗体）.frm

vb开发的公交查询系统

    RichTextBox1.SelStart = 0
    RichTextBox1.SelStart = RichTextBox1.Find("从地图上定位")
    RichTextBox1.Span ("从地图上定位起/终点只需先选择工具条中的第七/第八个按钮，" _
              & "而后用鼠标左键点击您的起/终点所在位置！")
    RichTextBox1.SelColor = RGB(180, 100, 100)
    RichTextBox1.SelStart = 0
      
    '滚动信息
    x(0) = " "
    x(1) = "欢"
    x(2) = "迎"
    x(3) = "使"
    x(4) = "用"
    x(5) = "长"
    x(6) = "春"
    x(7) = "公"
    x(8) = "交"
    x(9) = "智"
    x(10) = "能"
    x(11) = "化"
    x(12) = "查"
    x(13) = "询"
    x(14) = "系"
    x(15) = "统 "
    x(16) = "  "
    x(17) = "  "
    
    '读入数据表
    Dim TableName As String
    Dim RecordName As String
    Dim Field1 As String
    Dim Field2 As String
    Dim Field3 As String
    Dim i As Integer
    Dim j As Integer
    
    TableName = "c:\llxxqq\GongJiao\GongJiao.mdb"
    RecordName = "XS-BusnumStationnums"
    Field1 = "公交车次号"
    Field2 = "上下行标志"
    Field3 = "本趟公交车途经公交站点序列"
    
    Call ReadTable2(TableName, RecordName, Field1, Field2, Field3)
    For i = 1 To TotalBN
        For j = 0 To 1
            If FieldStr2(i, j) <> "" Then
               XSBusnumStationnumsStr(i, j) = FieldStr2(i, j)
            End If
        Next j
    Next i
    
    '----------------------------------------
 
    RecordName = "CX-BusnumStationnums"
    Field1 = "公交车次号"
    Field2 = "上下行标志"
    Field3 = "本趟公交车途经公交站点序列"
    
    Call ReadTable2(TableName, RecordName, Field1, Field2, Field3)
    For i = 1 To TotalBN
        For j = 0 To 1
            If FieldStr2(i, j) <> "" Then
               CXBusnumStationnumsStr(i, j) = FieldStr2(i, j)
            End If
        Next j
    Next i
    
    '-----------------------------------------
  
    RecordName = "StationnumBusnums"
    Field1 = "公交站点号"
    Field2 = "具有的公交车次号序列"
    
    Call ReadTable1(TableName, RecordName, Field1, Field2)
    For i = 1 To TotalSN
        If FieldStr1(i) <> "" Then
           StationnumBusnumsStr(i) = FieldStr1(i)
        End If
    Next i
        
    '---------------------------------------
    
    RecordName = "CX-StationNumName"
    Field1 = "公交站点号"
    Field2 = "公交站点名"
    
    Call ReadTable1(TableName, RecordName, Field1, Field2)
    For i = 1 To TotalSN
        If FieldStr1(i) <> "" Then
           CXStationName(i) = Trim(FieldStr1(i))
        End If
    Next i
        
    '---------------------------------------
 
    RecordName = "XS-StationNumName"
    Field1 = "公交站点号"
    Field2 = "公交站点名"
    
    Call ReadTable1(TableName, RecordName, Field1, Field2)
    For i = 1 To TotalStation
        If FieldStr1(i) <> "" Then
           XSStationName(i) = Trim(FieldStr1(i))
        End If
    Next i
        
    '----------------------------------------
   
    RecordName = "SamenameStation"
    Field1 = "新公交站点号"
    Field2 = "同名公交站点序列"
    
    Call ReadTable1(TableName, RecordName, Field1, Field2)
    For i = MidSN To TotalSN
        If FieldStr1(i) <> "" Then
           SamenameStationStr(i) = FieldStr1(i)
        End If
    Next i
        
      
    '----------------------------------------
 
    RecordName = "CX-CircleStation"
    Field1 = "公交站点号"
    Field2 = "周围公交站点序列"
    
    Call ReadTable1(TableName, RecordName, Field1, Field2)
    For i = 1 To TotalSN
        If FieldStr1(i) <> "" Then
           CXCircleStationStr(i) = FieldStr1(i)
        End If
    Next i
    
      
    '----------------------------------------
    
    RecordName = "XS-CircleStation"
    Field1 = "公交站点号"
    Field2 = "周围公交站点序列"
    
    Call ReadTable1(TableName, RecordName, Field1, Field2)
    For i = 1 To TotalStation
        If FieldStr1(i) <> "" Then
           XSCircleStationStr(i) = FieldStr1(i)
        End If
    Next i
    
    
    '----------------------------------------
    
    RecordName = "公交车次描述"
    Field1 = "公交车次"
    Field2 = "公交车次描述"
    
    Call ReadTable1(TableName, RecordName, Field1, Field2)
    For i = 1 To TotalBN
        If FieldStr1(i) <> "" Then
           BusDescrible(i) = FieldStr1(i)
        End If
    Next i
    
       
    '----------------------------------------
   
    RecordName = "XS-StationNumName"
    Field1 = "公交站点号"
    Field2 = "经度"
    Field3 = "纬度"
    Call ReadTable1(TableName, RecordName, Field1, Field2)
    For i = 1 To TotalStation
        If FieldStr1(i) <> "" Then
           Longitude(i) = FieldStr1(i)
        End If
    Next i
    Call ReadTable1(TableName, RecordName, Field1, Field3)
    For i = 1 To TotalStation
        If FieldStr1(i) <> "" Then
           Latitude(i) = FieldStr1(i)
        End If
    Next i
    
       
    '-------------------------------------------------
    Dim field4 As String
    Dim field5 As String
        
    RecordName = "公共场所查询"
    Field1 = "公共场所序号"
    Field2 = "主要公共场所名"
    Field3 = "经度"
    field4 = "纬度"
    field5 = "公共场所描述"
        
    Call ReadTable1(TableName, RecordName, Field1, Field2)
    For i = 1 To 100
        If FieldStr1(i) <> "" Then
           PubName(i) = FieldStr1(i)
        End If
    Next i
       
    Call ReadTable1(TableName, RecordName, Field1, Field3)
    For i = 1 To 100
        If FieldStr1(i) <> "" Then
           PubLatitude(i) = FieldStr1(i)
        End If
    Next i
    
    Call ReadTable1(TableName, RecordName, Field1, field4)
    For i = 1 To 100
        If FieldStr1(i) <> "" Then
           Publongtitude(i) = FieldStr1(i)
        End If
    Next i
    
    Call ReadTable1(TableName, RecordName, Field1, field5)
    For i = 1 To 100
        If FieldStr1(i) <> "" Then
           PubDescrible(i) = FieldStr1(i)
        End If
    Next i
    
    
    
    '------------------------------------------------------------
        
    'Dim field4 As String
    'Dim field5 As String
    Dim field6 As String
    Dim field7 As String
    
    RecordName = "Impedence"
    Field1 = "公交车次号"
    Field2 = "上下行标志"
    Field3 = "公交站点号"
    field4 = "Distance"
    field5 = "Time"
    field6 = "Cost"
    field7 = "Syn"
    
    
    Call ReadTable3(TableName, RecordName, Field1, Field2, Field3, field4)
    For i = 1 To TotalBN
        For j = 0 To 1
            For k = 1 To TotalStation
                If FieldStr3(i, j, k) <> "" Then
                    ImpedenceDistance(i, j, k) = FieldStr3(i, j, k)
                    'Text3.Text = Text3.Text & vbCrLf & ImpedenceDistance(i, j, k)
                End If
            Next k
        Next j
    Next i
    
    Call ReadTable3(TableName, RecordName, Field1, Field2, Field3, field5)
    For i = 1 To TotalBN
        For j = 0 To 1
            For k = 1 To TotalStation
                If FieldStr3(i, j, k) <> "" Then
                    ImpedenceTime(i, j, k) = FieldStr3(i, j, k)
                End If
            Next k
        Next j
    Next i
    
    Call ReadTable3(TableName, RecordName, Field1, Field2, Field3, field6)
    For i = 1 To TotalBN
        For j = 0 To 1
            For k = 1 To TotalStation
                If FieldStr3(i, j, k) <> "" Then
                    ImpedenceCost(i, j, k) = FieldStr3(i, j, k)
                End If
            Next k
        Next j
    Next i
    
    Call ReadTable3(TableName, RecordName, Field1, Field2, Field3, field7)
    For i = 1 To TotalBN
        For j = 0 To 1
            For k = 1 To TotalStation
                If FieldStr3(i, j, k) <> "" Then
                    ImpedenceSyn(i, j, k) = FieldStr3(i, j, k)
                End If
            Next k
        Next j
    Next i
           
    '为线路查询的公交车次获取准备
    For i = 1 To TotalBN
        If XSBusnumStationnumsStr(i, 0) <> "" Then
            RoadComb.AddItem i
        End If
    Next i
    
End Sub



'!!!!!!!!最后需要删除(不给用户)
Private Sub Map1_DblClick()
     Map1.Layers.LayersDlg
End Sub


'实现通过点击地图而进行出行起终点的输入
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

    If Map1.CurrentTool = SPoint And Button = vbLeftButton Then
        Map1.ConvertCoord x, y, XDown, YDown, miScreenToMap
        Call NearestStation(XDown, YDown)
        Fromtxt.Text = CXStationName(Val(NearestStationNum))
    End If
    
    If Map1.CurrentTool = EPoint And Button = vbLeftButton Then
        Map1.ConvertCoord x, y, XDown, YDown, miScreenToMap
        Call NearestStation(XDown, YDown)
        Totxt.Text = CXStationName(Val(NearestStationNum))
    End If

End Sub

'当箭头状鼠标在电子地图上移动时，状态条中显示当前点的经纬度
Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim XDown As Double
    Dim YDown As Double
    If Map1.CurrentTool = miArrowTool Then
        StatusBar1.Panels(1).ToolTipText = "当前点的经纬度"
        Map1.ConvertCoord x, y, XDown, YDown, miScreenToMap
        StatusBar1.Panels(1) = Mid(str(XDown), 1, 13) & vbTab & Mid(str(YDown), 1, 12)
    End If
End Sub

 
 '全部退出
Private Sub CmdExit_Click()
    End
End Sub


'工具条中工具的使用
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Dim flagGJ As Boolean
    
    On Error Resume Next
    Select Case Button.Key
        Case "Arrow"
            Map1.CurrentTool = miArrowTool
        Case "Zoom In"
            Map1.CurrentTool = miZoomInTool
        Case "Zoom Out"
            Map1.CurrentTool = miZoomOutTool
        Case "Pan"
            Map1.CurrentTool = miPanTool
        Case "Ruler"
            Map1.CurrentTool = 500