窗体代码： 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
|
|
