2010年10月17日

最新推荐文章于 2022-10-17 10:59:12 发布

梦幻骑士syc

最新推荐文章于 2022-10-17 10:59:12 发布

阅读量351

点赞数

分类专栏：学习

本文链接：https://blog.csdn.net/syc1988109/article/details/8514534

版权

学习专栏收录该内容

7 篇文章 0 订阅

订阅专栏

公交查询源代码+使用来电通数据库+计算倒车方案
2010-08-12 22:40

2010年10月17日 - 曲阜师大之梦幻骑士 - 梦幻骑士

窗体代码：

Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const LB_SETHORIZONTALEXTENT = &H194

Private Sub SetHscroll(lst As ListBox) '自定义函数为 listbox 加上水平滚动条
SendMessage lst.hwnd, LB_SETHORIZONTALEXTENT, 500, 0
End Sub

Public Sub Cmdsearch_Click()    '查询
If Comfindstart.Text = "" And Comfindend.Text = "" Then
   MsgBox "请先输入查询内容!"
   Exit Sub
End If
If Comfindstart.Text <> "" And Comfindend = "" Then
   '只查询起点站
   LabInFo.Caption = "正在查询 <" & Comfindstart.Text & ">的信息...."
   Timer.Enabled = True
   MoHuFindStart
   Search_ZhanTai Comfindstart.Text
   LabInFo.Caption = "查询完毕!"
   Timer.Enabled = False
   Exit Sub
End If
If Comfindstart.Text <> "" And Comfindend.Text <> "" Then
   '站台--站台查询
   LabInFo.Caption = "正在查询 <" & Comfindstart.Text & ">到<" & Comfindend.Text & ">的信息...."
   Timer.Enabled = True
   MoHuFindStart
   MoHuFindEnd
   Search_ZhanTaiToZhanTai Comfindstart.Text, Comfindend.Text
   LabInFo.Caption = "查询完毕!"
   Timer.Enabled = False
End If

End Sub

Private Sub Comfind_KeyPress(KeyAscii As Integer) '按下键盘的回车键
If KeyAscii = 13 Then
Cmdsearch_Click
End If
End Sub

Public Sub MoHuFindEnd()         '模糊查找终点站的信息
If Len(Comfindend.Text) < 2 Then Exit Sub
Dim i As Integer
Dim j As Integer
Dim h As Integer
Txtinfo.Text = ""
Txtinfo.Text = Txtinfo.Text & vbCrLf & "正在模糊匹配终点站的信息,您可在下拉框中选择相近的信息......" & vbCrLf
For i = 1 To BusTotalNum
    For j = 1 To BusZhanTaiTotal
        DoEvents
        If Left(BusInfo(i, j), 2) = Left(Comfindend.Text, 2) Then
           '找到匹配的添加进来
           '如果列表中存在的话则不需要添加了
           For h = 0 To Comfindend.ListCount
               If Comfindend.List(h) = BusInfo(i, j) Then
                  Exit For
               End If
           Next h
           If h = Comfindend.ListCount + 1 Then
              Comfindend.AddItem BusInfo(i, j)
           End If
        End If
        DoEvents
    Next j
Next i
End Sub

Private Sub Comfindend_Click()
Me.Cmdsearch_Click
End Sub

Private Sub Comfindend_KeyPress(KeyAscii As Integer) '按下键盘的回车键
If KeyAscii = 13 Then
MoHuFindEnd
Cmdsearch_Click
End If
End Sub

Public Sub MoHuFindStart()          '模糊查找起点站,将相近的信息显示在列表框中
Dim i As Integer
Dim j As Integer
Dim h As Integer
If Len(Comfindstart.Text) < 2 Then Exit Sub
Txtinfo.Text = ""
Txtinfo.Text = Txtinfo.Text & vbCrLf & "正在模糊匹配起点站的信息,您可在下拉框中选择相近的信息......" & vbCrLf
For i = 1 To BusTotalNum
    For j = 1 To BusZhanTaiTotal
        DoEvents
        If Left(BusInfo(i, j), 2) = Left(Comfindstart.Text, 2) Then
           '找到匹配的添加进来
           '如果列表中存在的话则不需要添加了
           For h = 0 To Comfindstart.ListCount
               If Comfindstart.List(h) = BusInfo(i, j) Then
                  Exit For
               End If
           Next h
           If h = Comfindstart.ListCount + 1 Then
              Comfindstart.AddItem BusInfo(i, j)
           End If
        End If
        DoEvents
    Next j
Next i
End Sub

Private Sub Comfindstart_Click()
Me.Cmdsearch_Click
End Sub

Private Sub Comfindstart_KeyPress(KeyAscii As Integer)   '按下键盘的回车键
If KeyAscii = 13 Then
    MoHuFindStart
    Cmdsearch_Click
End If
End Sub

Private Sub Command1_Click() '测试数据库
Dim i As Integer
Dim j As Integer
Dim InFo As String
Dim Temp As String

For i = 1 To BusTotalNum
    'List1.AddItem BusName(i)
    'List2.AddItem BusInfo(i)
Next i
For i = 1 To BusTotalNum
    For j = 1 To BusZhanTaiTotal
        Temp = BusInfo(i, j)
        If Temp <> "" Then
           InFo = InFo & Temp & " "
        End If
     Next j
     List2.AddItem InFo
     InFo = ""
Next i
End Sub

Private Sub Form_Load()
'LoadLibraryFile
SetHscroll List2
ShuaXin
End Sub
Public Sub ShuaXin()            '刷新显示数据库
Dim i As Integer
Labkucity.Caption = BusCity          '显示公交城市名称
Labbustotal.Caption = BusTotalNum    '显示数据库中公交车的数量
Labkudate.Caption = DataBaseVer      '显示数据库的版本信息
ListBus.Clear
For i = 1 To BusTotalNum
     ListBus.AddItem BusName(i)
Next i
FraBusInFo.Caption = "公交车信息 " & i - 1
'默认显示第一辆公交车次的信息
If ListBus.ListCount > 0 Then
    ListBus.Selected(0) = True
    LabQiDian.Caption = BusXinXi(1, 1)
    LabQiDianTime.Caption = BusXinXi(1, 2)
    LabZhongDian.Caption = BusXinXi(1, 3)
    LabZhongDianTime.Caption = BusXinXi(1, 4)
    LabLeiXing.Caption = BusXinXi(1, 5)
    '显示本车次的站台信息
    ListZhanTai.Clear
    For i = 1 To BusZhanTaiTotal
        If BusInfo(1, i) <> "" Then
           ListZhanTai.AddItem BusInfo(1, i)
        End If
    Next i
End If
End Sub

Public Sub Search_ZhanTai(Str As String) '站台信息查询
Dim BusNameXiaBiao() As Integer '保存查到的公交车在数组中的下标
Dim i As Integer
Dim j As Integer
Dim xb As Integer

If Str = "" Then
MsgBox "查询不能为空，请输入数据！"
Exit Sub
End If

'根据公交车的数量重新定义数组
ReDim BusNameXiaBiao(BusTotalNum)

xb = 1
For i = 1 To BusTotalNum
    For j = 1 To BusZhanTaiTotal
        DoEvents
        If BusInfo(i, j) = Str Then
           'MsgBox BusName(i) & "经过本站！"
           BusNameXiaBiao(xb) = i
           xb = xb + 1
        End If
        DoEvents
    Next j
Next i
If xb = 1 Then
   Txtinfo.Text = Txtinfo.Text & vbCrLf & "没有查询到经过< " & Str & " >的公交车信息!"
   Txtinfo.Text = Txtinfo.Text & vbCrLf & "您可在下拉框中选择软件为您匹配的信息进行再次查询!"
   Exit Sub
End If
Txtinfo.Text = "经过< " & Str & " >" & "的公交车有：" & Chr(13) & Chr(10)
For i = 1 To xb
   DoEvents
   If BusName(BusNameXiaBiao(i)) = "" Then
      Exit For
   End If
   If i Mod 6 = 0 Then Txtinfo.Text = Txtinfo.Text & vbCrLf
   DoEvents
   Txtinfo.Text = Txtinfo.Text & "   " & BusName(BusNameXiaBiao(i))
Next i
End Sub

Public Sub Search_ZhanTaiToZhanTai(StrStart As String, StrEnd As String) '站台--站台之间查询

If StrStart = "" Or StrEnd = "" Then
   MsgBox "站台--站台查询不能为空！"
   Exit Sub
End If
'原理：首先查询起点站，将经过的车辆信息保存到数组A中，然后查询终点站台信息将经过的车辆信息保存到数组B中；
'      如果两个数组中有相同的说明1有经过起点和终点的直达车，如果没有的话开始计算倒车。

Dim BusXBA() As Integer '保存经过起点的公交车信息
Dim BusXBB() As Integer '保存经过终点的公交车信息

ReDim BusXBA(BusTotalNum)
ReDim BusXBB(BusTotalNum)

Dim i As Integer
Dim j As Integer
Dim xb As Integer

'首先查询经过起点的公交车信息
xb = 1
For i = 1 To BusTotalNum
    For j = 1 To BusZhanTaiTotal
        If BusInfo(i, j) = Comfindstart.Text Then
           BusXBA(xb) = i
           xb = xb + 1
        End If
        DoEvents
    Next j
Next i
'查询经过终点的公交车信息
xb = 1
For i = 1 To BusTotalNum
    For j = 1 To BusZhanTaiTotal
        If BusInfo(i, j) = Comfindend.Text Then
           BusXBB(xb) = i
           xb = xb + 1
        End If
        DoEvents
    Next j
Next i
'判断两个下标数组中是否有相同的内容
Dim XBTemp() As Integer   '保存下标数组中相同内容的下标
ReDim XBTemp(BusTotalNum)

xb = 1
For i = 1 To BusTotalNum
    If BusXBA(i) = 0 Then
       Exit For
    End If
    DoEvents
    For j = 1 To BusTotalNum
        If BusXBA(i) = BusXBB(j) Then
           '查询到相同公交车
           XBTemp(xb) = i
           xb = xb + 1
        End If
     Next j
Next i
If xb <> 1 Then
    '找到了直达车!
    Txtinfo.Text = "经过起点站和终点站的直达车有：" & Chr(13) & Chr(10)
    For i = 1 To xb
        Txtinfo.Text = Txtinfo.Text & BusName(BusXBA(XBTemp(i))) & "   "
    Next i
Else
    '没有找到直达车
    If BusXBA(1) <> 0 Then
       '找到经过起点的车辆,在界面中显示
       Txtinfo.Text = "经过起点站<" & StrStart & ">的车有：" & Chr(13) & Chr(10)
       For i = 1 To BusTotalNum
           DoEvents
           If BusXBA(i) = 0 Then Exit For
           Txtinfo.Text = Txtinfo.Text & BusName(BusXBA(i)) & "   "
       Next i
    End If
    If BusXBB(1) <> 0 Then
       '找到经过终点的车辆,在界面中显示
       Txtinfo.Text = Txtinfo.Text & Chr(13) & Chr(10) & "经过终点站<" & StrEnd & ">的车有：" & Chr(13) & Chr(10)
       For i = 1 To BusTotalNum
           DoEvents
           If BusXBB(i) = 0 Then Exit For
           Txtinfo.Text = Txtinfo.Text & BusName(BusXBB(i)) & "   "
       Next i
    End If
    Txtinfo.Text = Txtinfo.Text & vbCrLf
    '如果既有经过起点的车也有经过终点的车，计算是否需要倒车
    '判断是否有交汇的车。
    Dim TempJH As String
    If BusXBA(1) <> 0 And BusXBB(1) <> 0 Then
       For i = 1 To BusTotalNum
           DoEvents
           For j = 1 To BusTotalNum
               If (BusJiaoHui(BusXBA(i), BusXBB(j))) <> "" Then
                   '找到交汇的车辆
                   TempJH = BusJiaoHui(BusXBA(i), BusXBB(j))
                   Txtinfo.Text = Txtinfo.Text & Chr(13) & Chr(10)
                   Txtinfo.Text = Txtinfo.Text & "您需要倒车： " & Chr(13) & Chr(10)
                   Txtinfo.Text = Txtinfo.Text & "坐 " & BusName(BusXBA(i)) & " 车在 " & TempJH & " 换成 " & BusName(BusXBB(j)) & " 车"
               End If
           Next j
       Next i
    End If
End If

End Sub

Public Function ZhanTaiInBus(StrZhanTai As String, TempXB As Integer) As Boolean '判断指定的车次中是否经过指定的站台，存在的话返回真
'TempXB 要查询的车次在车次数组中的下标

If StrZhanTai = "" Then Exit Function

Dim i As Integer

For i = 1 To BusZhanTaiTotal
    If BusInfo(TempXB, i) = StrZhanTai Then
       '找到了查询的站台
       ZhanTaiInBus = True
       Exit Function
    End If
Next i
ZhanTaiInBus = False
End Function

Public Function BusJiaoHui(XBA As Integer, XBB As Integer) As String '查询两辆公交车是否存在交汇的站台，如果存在的话可以倒车。
'如果存在返回第一个交汇的站台，否则返回 ""
Dim i As Integer
Dim j As Integer

For i = 1 To BusZhanTaiTotal
    DoEvents
    For j = 1 To BusZhanTaiTotal
        If BusInfo(XBA, i) = BusInfo(XBB, j) Then
           '找到了交汇的点
           BusJiaoHui = BusInfo(XBA, i)
           Exit Function
        End If
     Next j
Next i
BusJiaoHui = ""
End Function

Private Sub Form_Unload(Cancel As Integer)
End '结束程序的运行
End Sub

Private Sub ListBus_Click() '单击显示相关的信息
Dim i As Integer
LabQiDian.Caption = BusXinXi(ListBus.ListIndex + 1, 1)
LabQiDianTime.Caption = BusXinXi(ListBus.ListIndex + 1, 2)
LabZhongDian.Caption = BusXinXi(ListBus.ListIndex + 1, 3)
LabZhongDianTime.Caption = BusXinXi(ListBus.ListIndex + 1, 4)
LabLeiXing.Caption = BusXinXi(ListBus.ListIndex + 1, 5)
'显示本车次的站台信息
ListZhanTai.Clear
For i = 1 To BusZhanTaiTotal
    If BusInfo(ListBus.ListIndex + 1, i) <> "" Then
       ListZhanTai.AddItem BusInfo(ListBus.ListIndex + 1, i)
    End If
Next i
'显示本车次的站台数量
LabZhanTaiNum.Caption = ListZhanTai.ListCount
End Sub

Private Sub ListZhanTai_DblClick() '双击站台信息列表查询经过本站台的所有车次信息
Comfindstart.Text = ListZhanTai.List(ListZhanTai.ListIndex)
Me.Cmdsearch_Click
End Sub

Private Sub mnuabout_Click()
关于.Show 1
End Sub

Private Sub mnudatabase_Click() ' 选择数据库
FrmDataBase.Show 1
End Sub

Public Sub HuiTu()           '根据坐标绘制地图
Dim i As Integer
Dim j As Integer
'设置绘制的点的大小
Picture1.DrawWidth = 5
For i = 1 To Picture1.Width Step 100
     For j = 1 To Picture1.Height Step 100
         Picture1.PSet (i, j), RGB(Rnd * 255, Rnd * 255, Rnd * 255)
     Next j
Next i
'将picture控件中的图像保存为文件的方法
Picture1.ForeColor = vbGreen
Picture1.AutoRedraw = True
SavePicture Picture1.Image, App.Path & "/123.jpg"
End Sub

Private Sub Picture1_Click()
HuiTu
End Sub

Private Sub TexFindBus_KeyPress(KeyAscii As Integer)
Dim i As Integer
Dim j As Integer

If KeyAscii = 13 Then
   For i = 1 To BusTotalNum
       If InStr(BusName(i), TexFindBus.Text) > 0 Then
          ListBus.Selected(i - 1) = True
          LabQiDian.Caption = BusXinXi(i, 1)
          LabQiDianTime.Caption = BusXinXi(i, 2)
          LabZhongDian.Caption = BusXinXi(i, 3)
          LabZhongDianTime.Caption = BusXinXi(i, 4)
          LabLeiXing.Caption = BusXinXi(i, 5)
          '显示本车次的站台信息
          ListZhanTai.Clear
          For j = 1 To BusZhanTaiTotal
              If BusInfo(i, j) <> "" Then
                ListZhanTai.AddItem BusInfo(i, j)
              End If
          Next j
          Exit For
       End If
   Next i
End If
End Sub

Private Sub Timer_Timer() '显示查询的动画
Static i As Integer
If i = 0 Then
   i = 1
   Shape.FillColor = vbGreen
Else
   i = 0
   Shape.FillColor = vbRed
End If
End Sub

Public Function LoadLiShiFind() '导入历史查询中的信息

End Function
Public Function SaveLiShiFind() '保存历史查询信息

End Function

公交查询源代码+使用来电通数据库+计算倒车方案：模块代码
2010-08-12 22:41

Option Explicit
Public BusCity As String '城市名称
Public DataBaseVer As String '数据库版本信息

Public BusTotalNum As Integer             '公交车数量
Public BusZhanTaiTotal As Integer         '公交车内的站台数量的最大值
Public BusInfo() As String                '保存公交站台信息的数组
Public BusName() As String                '保存公交名称信息的数组
Public BusXinXi() As String                '保存公交车的起点,终点,时间,价格等信息
Public BusZhanTaiZuoBiao() As String      '保存公交站台坐标的信息

Public Sub Main()    '主函数
BusZhanTaiTotal = 100 '设置每辆公交车内的最多经过的站台数目
FrmDataBase.Hide
ChuShiHua          '初始化
公交查询.Show
End Sub
Public Function ChuShiHua()        '系统初始化分析数据库文件
Dim FileName As String

FrmDataBase.File1.Path = App.Path & "\数据库\"
If FrmDataBase.File1.ListCount < 1 Then
   MsgBox "当前目录下的数据库文件夹中没有TXT格式的数据库文件!" & vbCrLf & "请先复制数据库文件到当前目录下的数据库文件夹中!" & vbCrLf & "支持来电通公交查询系统数据库文件(需保存为ASCII码文件)!"
   End
End If
If FrmDataBase.File1.ListCount = 1 Then
   FileName = App.Path & "\数据库\" & FrmDataBase.File1.List(0)
   'MsgBox FileName
   LoadDataBaseFile FileName
Else
   '如果有多个数据库文件则让用户选择
   FrmDataBase.Show 1
End If
End Function
Public Function LoadDataBaseFile(FileName As String)     '导入来电通格式的数据库文件
Dim i As Integer
Dim j As Integer
Dim Ch As String
Dim Temp As String          '获得数据库中每一行的数据
Dim FreeF As Integer
Dim TestStr As String       '用于测试的字符串
Dim BusData As String       '得到的信息
Dim Str As String
Dim BusShuLiang As Integer   '公交车次的数量

FreeF = FreeFile
'On Error GoTo FindERR
ReDim BusName(500)               '重新定义公交车次数组
ReDim BusInfo(500, 100)          '重新定义每辆车站台信息数组
ReDim BusXinXi(500, 5)           '重新定义公交信息数组
                                 '(i,1)起点站
                                 '(i,2)起点站时间
                                 '(i,3)终点站
                                 '(i,4)终点站时间
                                 '(i,5)价格
Open FileName For Input As FreeF
     Do Until EOF(FreeF)
        Line Input #FreeF, Temp
        If Left(Temp, 10) = "[APPTITLE]" Then                 '获得公交城市信息
           BusCity = Right(Temp, Len(Temp) - 11)
           'MsgBox BusCity
           '[APPTITLE] = 济宁公交
        End If
        If Left(Temp, 13) = "[DATAVERSION]" Then                 '获得数据库版本信息
           DataBaseVer = Right(Temp, Len(Temp) - 14)
           'MsgBox DataBaseVer
           '[DATAVERSION] = 清玉风JiNan090925
        End If
        If Temp = "[MAINDATASTART]" Then
            '表示与遇到公交信息的主体数据了
            '公交数据
            '线路名称,起点站,起点站首班时间,起点站末班时间,终点站,终点站首班时间,终点站末班时间,类型,上行,下行,备注
            BusShuLiang = 0
            While Temp <> "[MAINDATAEND]"
                  BusShuLiang = BusShuLiang + 1
                  Line Input #FreeF, Temp
                  'MsgBox Temp
                  Str = ""
                  j = 0
                  For i = 1 To Len(Temp)
                      Ch = Mid(Temp, i, 1)
                      Str = Str & Ch
                      If j <> 8 Then
                         If Ch = "," Then
                            If j = 0 Then           '得到的是公交车次的信息
                               Str = Left(Str, Len(Str) - 1)    '去掉str中的","
                               'MsgBox Str
                               BusName(BusShuLiang) = Str
                               Str = ""
                            ElseIf j = 1 Then       '得到起点站信息
                               Str = Left(Str, Len(Str) - 1)
                               'MsgBox Str
                               BusXinXi(BusShuLiang, 1) = Str
                               Str = ""
                            ElseIf j = 2 Then       '得到起点站首班时间
                               Str = Left(Str, Len(Str) - 1)
                                BusXinXi(BusShuLiang, 2) = Str
                               'MsgBox Str
                               Str = ""
                            ElseIf j = 3 Then       '得到起点末班时间
                               Str = Left(Str, Len(Str) - 1)
                                BusXinXi(BusShuLiang, 2) = BusXinXi(BusShuLiang, 2) & "--" & Str
                               'MsgBox Str
                               Str = ""
                            ElseIf j = 4 Then       '得到终点站
                               Str = Left(Str, Len(Str) - 1)
                                BusXinXi(BusShuLiang, 3) = Str
                               'MsgBox Str
                               Str = ""
                            ElseIf j = 5 Then       '得到终点站首班时间
                               Str = Left(Str, Len(Str) - 1)
                                BusXinXi(BusShuLiang, 4) = Str
                               'MsgBox Str
                               Str = ""
                            ElseIf j = 6 Then       '得到终点站末班时间
                               Str = Left(Str, Len(Str) - 1)
                               BusXinXi(BusShuLiang, 4) = BusXinXi(BusShuLiang, 4) & "--" & Str
                               'MsgBox Str
                               Str = ""
                            ElseIf j = 7 Then       '得到类型信息(价格)
                               Str = Left(Str, Len(Str) - 1)
                                BusXinXi(BusShuLiang, 5) = Str
                               'MsgBox Str
                               Str = ""
                            End If
                            j = j + 1
                         End If

                      Else
                         '遇到正文了
                         BusData = Right(Temp, (Len(Temp) - i + 1))
                         '退出本次的for循环
                         Exit For
                      End If
                  Next i

                  Str = ""
                  Dim ZhanTaiShuLiang As Integer    '每次的到的站台保存时的下标
                  ZhanTaiShuLiang = 0

                  For i = 1 To Len(BusData)
                      Ch = Mid(BusData, i, 1)
                      If Ch <> "-" And Ch <> "," Then
                         Str = Str & Ch
                      Else
                         '表示得到一个完整的站台信息
                         ZhanTaiShuLiang = ZhanTaiShuLiang + 1
                         BusInfo(BusShuLiang, ZhanTaiShuLiang) = Str
                         Str = ""
                         If Ch = "," Then
                            Exit For
                            '目前暂不保存下行的路线
                         End If
                      End If
                  Next i
            Wend
        End If
     Loop
     BusTotalNum = BusShuLiang
       ' MsgBox j
Close FreeF
Exit Function
FindErr:
       'MsgBox "测试代码:" & vbCrLf & TestStr
End Function

'打开公交线路数据库函数
Public Function LoadLibraryFile()
Dim FileName As String
Dim Temp As String
Dim Str As String
Dim i As Integer
Dim Ch As String
Dim city As String
Dim X As Integer
Dim Y As Integer

'/*
'城市: 济南
'公交车数量：4
'编辑日期：2009-9-5
'编辑人员: 张海波
'*/

FileName = App.Path & "\数据库\济南.txt"
X = 0
Y = 0

On Error GoTo ErrLoad

Open FileName For Input As #1
     Line Input #1, Temp
          If Temp <> "/*" Then
             MsgBox FileName & Chr(13) & Chr(10) & "表头注释项目" & Chr(13) & Chr(10) & "数据库格式不正确，请重新编辑！"
          End If
      '处理城市名称
     Line Input #1, Temp
             For i = 1 To Len(Temp)
                 Ch = Mid(Temp, i, 1)
                 If Ch <> "：" Then
                    Str = Str & Ch
                 Else
                    Exit For
                 End If
             Next i
             If Str = "城市" Then
                公交查询.Labkucity.Caption = Right(Temp, Len(Temp) - i)
             Else
                MsgBox FileName & Chr(13) & Chr(10) & " 城市项目" & Chr(13) & Chr(10) & "数据库格式不正确，请重新编辑！"
             End If
     '处理公交车数量
     Temp = ""
     Ch = ""
     Str = ""
     Line Input #1, Temp
          For i = 1 To Len(Temp)
              Ch = Mid(Temp, i, 1)
              If Ch <> "：" Then
                 Str = Str & Ch
              Else
                 Exit For
              End If
          Next i
          If Str = "公交车数量" Then
             BusTotalNum = Val(Right(Temp, Len(Temp) - i))
             公交查询.Labbustotal.Caption = Right(Temp, Len(Temp) - i)
             '根据公交车的数量重新定义动态数组
             ReDim BusName(BusTotalNum)
             ReDim BusInfo(BusTotalNum, BusZhanTaiTotal)
             ReDim BusZhanTaiZuoBiao(BusTotalNum, BusZhanTaiTotal)
          Else
             MsgBox FileName & Chr(13) & Chr(10) & " 公交车数量项目" & Chr(13) & Chr(10) & "数据库格式不正确，请重新编辑！"
          End If
     '处理编辑日期
     Temp = ""
     Ch = ""
     Str = ""
     Line Input #1, Temp
          For i = 1 To Len(Temp)
              Ch = Mid(Temp, i, 1)
              If Ch <> "：" Then
                 Str = Str & Ch
              Else
                 Exit For
              End If
           Next i
           If Str = "编辑日期" Then
              公交查询.Labkudate.Caption = Right(Temp, Len(Temp) - i)
           Else
              MsgBox FileName & Chr(13) & Chr(10) & " 编辑日期" & Chr(13) & Chr(10) & "数据库格式不正确，请重新编辑！"
           End If
    '处理编辑人员
     Temp = ""
     Ch = ""
     Str = ""
     Line Input #1, Temp
          For i = 1 To Len(Temp)
              Ch = Mid(Temp, i, 1)
              If Ch <> "：" Then
                 Str = Str & Ch
              Else
                 Exit For
              End If
          Next i
          If Str = "编辑人员" Then
             公交查询.Labkuuser.Caption = Right(Temp, Len(Temp) - i)
          Else
             MsgBox FileName & Chr(13) & Chr(10) & " 编辑人员" & Chr(13) & Chr(10) & "数据库格式不正确，请重新编辑！"
          End If
     '读取结束标志
     Line Input #1, Temp
          If Temp <> "*/" Then
             MsgBox FileName & Chr(13) & Chr(10) & "表头注释项目" & Chr(13) & Chr(10) & "数据库格式不正确，请重新编辑！"
          End If
     '开始读取公交车信息
     '动态定义数组
     'businfo()
     Dim StrTemp As String
     Dim m As Integer
      Do Until EOF(1)
         Line Input #1, Temp
              Str = ""
              For i = 1 To Len(Temp)
                  Ch = Mid(Temp, i, 1)
                  If Ch <> "-" Then
                     Str = Str & Ch
                  Else
                     Exit For
                  End If
              Next i
              If Str = BusName(X) Then
                 '如果公交车名称数组中已经有相关信息，则直接添加到数组中
                 '数据库格式：1路-洪家楼-123.23,34.45
                 StrTemp = Right(Temp, Len(Temp) - i)
                 Str = ""
                 For m = 1 To Len(StrTemp)
                     Ch = Mid(StrTemp, m, 1)
                     If Ch <> "-" Then
                        Str = Str & Ch
                     Else
                        Exit For
                     End If
                 Next m
                 '开始处理坐标信息
                 If m = Len(StrTemp) + 1 Then
                    '如果数据库中没有没有发现坐标信息
                    BusInfo(X, Y) = Str
                    Y = Y + 1
                 Else
                   '如果数据库中存在坐标信息
                    BusZhanTaiZuoBiao(X, Y) = Right(StrTemp, Len(StrTemp) - m)
                    BusInfo(X, Y) = Str
                    Y = Y + 1
                  End If
              ElseIf Str <> "" Then
                '公交数组中没有相关信息
                 X = X + 1
                 Y = 1
                 BusName(X) = Str
                 StrTemp = Right(Temp, Len(Temp) - i)
                 Str = ""
                 For m = 1 To Len(StrTemp)
                     Ch = Mid(StrTemp, m, 1)
                     If Ch <> "-" Then
                        Str = Str & Ch
                     Else
                        Exit For
                     End If
                 Next m
                 '开始处理坐标信息
                 If m = Len(StrTemp) + 1 Then
                    '如果数据库中不存坐标信息
                    BusInfo(X, Y) = Str
                    Y = Y + 1
                 Else
                   '如果坐标中存在坐标信息
                   BusZhanTaiZuoBiao(X, Y) = Right(StrTemp, Len(StrTemp) - m)
                   BusInfo(X, Y) = Str
                   Y = Y + 1
                 End If
            End If
       Loop

Close #1
Exit Function
ErrLoad:
   MsgBox FileName & Chr(13) & Chr(10) & "打开失败！"
   Exit Function

End Function