📄 module1.bas
字号:
Attribute VB_Name = "Module1"
Option Explicit
Const nMax = 10000 ' 虚拟一个"无穷大"
Const nMaxIcon = 6 ' 单程票最大个数
Public Const nStations = 31 ' 一二号线总站名
Public Const stationName = "广州东站,体育中心,体育西路,杨箕,东山口,烈士陵园,农讲所,公园前,西门口,陈家祠,长寿路,黄沙,芳村,花地湾,坑口,西朗,三元里,广州火车站,越秀公园,纪念堂,海珠广场,市二宫,江南西,晓港,中大,鹭江,客村,赤岗,磨碟沙,新港东,琶洲,"
Public dMap(nStations, nStations) As Integer ' 最短距离矩阵
Public Stations(nStations) As String ' 站名列表
Public destStation As String ' 目的地站名
Public startStation As String ' 初始站名
Public nStartStation As Integer ' 初始站名编号
Public nMax10Yuan As Integer ' 10元纸币最大数
Public nShowed1Yuan As Integer ' 已显示的1元硬币数
Public Sub setInitStation(ByVal sName As String)
startStation = sName ' 设置初始站名
frmMain.Caption = "广州地铁自动售票机 " + "(" + startStation + ")"
End Sub
' ===== 初始化系统信息 =====
Public Sub Init()
Dim i As Integer
Call splitStation ' 产生站名数组
Call creatMetroMap ' 产生站点最短路径图表
nStartStation = getStationNO(startStation)
frmMain.lblStation(nStartStation).Enabled = False ' 禁止初始站点点击
' 初始化显示框
With frmMain
' fraPage2
.txtPrice.Text = 0
.txtTicketNum.Text = 1
.txtCost.Text = 0
.txtAccount.Text = 0
.txtPaid.Text = 0
.txtChange.Text = 0
.txtDestStation.Text = 0
' fraPage3
.txtSelectedTicketNum.Text = 1
' 清除多余纸币,保留img10Yuan(0)
End With
End Sub
' ===== 产生站名列表 =====
Public Sub splitStation()
Dim s As String
Dim i As Integer, k As Integer
s = stationName
For i = 1 To nStations
k = InStr(s, ",")
Stations(i) = Left$(s, k - 1)
s = Mid$(s, k + 1)
Next
End Sub
' ===== 产生站点最短路径图表 =====
Public Sub creatMetroMap()
Dim midPoint As Integer, startPoint As Integer, endPoint As Integer
Dim i As Integer, j As Integer
' 初始化最短路径图表
For i = 1 To nStations
For j = 1 To nStations
If i = j Then
dMap(i, j) = 0 ' 同站距离为0
ElseIf j = i - 1 Or j = i + 1 Then
dMap(i, j) = 1 ' 相邻站距离为1
Else
dMap(i, j) = nMax ' 否则距离为无穷大
End If
Next
Next
' 修正部分站点,如交换站,或一二号线
' 注,按列表编号 公园前[8], 西朗[16], 三元里[17], 纪念堂[20], 海珠广场[21]
' -- 公园前与纪念堂
dMap(8, 20) = 1
dMap(20, 8) = 1
' -- 公园前与海珠广场
dMap(8, 21) = 1
dMap(21, 8) = 1
' -- 西朗与三元里
dMap(16, 17) = nMax
dMap(17, 16) = nMax
' 计算最短路径图表
For midPoint = 1 To nStations
For startPoint = 1 To nStations
For endPoint = 1 To nStations
If dMap(startPoint, endPoint) > dMap(startPoint, midPoint) + dMap(midPoint, endPoint) Then
dMap(startPoint, endPoint) = dMap(startPoint, midPoint) + dMap(midPoint, endPoint) ' 保存最短路径长度
End If
Next
Next
Next
End Sub
' 以始、终站名,查表计算票价
Public Function ticketCost(ByVal sStart As String, ByVal sEnd As String) As Integer
Dim i As Integer, startP As Integer, endP As Integer
Dim n As Integer
' 查表出发站和终点站对应编号
If sStart = sEnd Then ' 同站不能选择
ticketCost = 0
Exit Function
End If
For i = 1 To nStations
If Stations(i) = sStart Then startP = i
If Stations(i) = sEnd Then endP = i
Next
n = dMap(startP, endP) ' 查表得出两站距离
ticketCost = 2 + (n - 1) \ 3 ' 票价从2元始,每3站加1元
End Function
' 切换界面,编号[1]选站名提示;[2]投币;[3]买多张
Public Sub changeScreen(ByVal p As Integer)
Call showIcons(0, 0) ' 隐藏单程票和硬币
frmMain.img10Yuan(0).Move 451, 18 ' 恢复10元纸币位置
frmMain.lblFinishTip.Visible = False ' 隐藏取票提示
frmMain.fraPage2.Enabled = True
Select Case p
Case 1
Call setStationEnable(True) ' 允许选站名
frmMain.fraPage1.Visible = True
frmMain.fraPage2.Visible = False
frmMain.fraPage3.Visible = False
frmMain.cmdInsertMoney.Visible = False
Case 2
Call setStationEnable(True) ' 允许选站名
frmMain.fraPage1.Visible = False
frmMain.fraPage2.Visible = True
frmMain.fraPage3.Visible = False
frmMain.cmdInsertMoney.Visible = True
Case 3
Call setStationEnable(False) ' 禁止选站名
frmMain.fraPage1.Visible = False
frmMain.fraPage2.Visible = False
frmMain.fraPage3.Visible = True
frmMain.cmdInsertMoney.Visible = False
End Select
End Sub
' 计算票价并显示
Public Sub setPage2()
With frmMain
.txtDestStation.Text = destStation
.txtPrice.Text = ticketCost(startStation, destStation) ' 显示单价
.txtTicketNum.Text = 1 ' 显示默认张数
.txtCost.Text = .txtPrice * .txtTicketNum ' 算总价
.txtAccount.Text = .txtCost.Text
End With
End Sub
' 获取站名所在编号
Public Function getStationNO(ByVal station As String) As Integer
Dim i As Integer, n As Integer
n = -1
For i = 1 To nStations
If station = Stations(i) Then
n = i - 1
Exit For
End If
Next
getStationNO = n
End Function
' 计算购票总价
Public Sub calculateAccount()
With frmMain
.txtCost.Text = .txtPrice * .txtTicketNum
.txtAccount.Text = .txtCost
End With
End Sub
' 投币,并求余,出票
Public Sub insertMoney(ByVal nMoney As Integer)
Dim i As Integer
With frmMain
.txtPaid.Text = .txtPaid + nMoney ' 追加已付款
' 判断已付款是否超过应付款,若超过则出票,否则等待
If frmMain.txtPaid - frmMain.txtAccount >= 0 Then
.txtChange.Text = .txtPaid - .txtAccount ' 求余
Call showIcons(.txtTicketNum, .txtChange) ' 出票
Call finishExchange ' 结束交易
End If
End With
End Sub
' 交易完成处理
Sub finishExchange()
Dim i As Integer
frmMain.lblFinishTip.Visible = True
frmMain.fraPage2.Enabled = False
' 删除多余10元纸币
For i = 1 To nMax10Yuan - 1
Unload frmMain.img10Yuan(i)
Next
End Sub
' 设置站名选择是否允许
Sub setStationEnable(ByVal Enabled As Boolean)
Dim i As Integer
For i = 0 To nStations - 1
If i <> nStartStation Then
frmMain.lblStation(i).Enabled = Enabled
End If
Next
End Sub
' 设置单程票和1元硬币各显示多少张
Sub showIcons(ByVal nIcon As Integer, ByVal n1Yuan As Integer)
Const IconX1 = 660
Const IconX2 = 900
Const IconW = 65
Dim i As Integer
Dim d1 As Integer, d2 As Integer
' 计算每币间隔
If nIcon > 1 Then
d1 = (IconX2 - IconX1) / (nIcon - 1)
d1 = IIf(d1 > IconW, IconW, d1)
End If
If n1Yuan > 1 Then
d2 = (IconX2 - IconX1) / (n1Yuan - 1)
d2 = IIf(d2 > IconW, IconW, d2)
End If
' 显示单程票
For i = 0 To nIcon - 1
frmMain.imgIcon(i).Left = IconX1 + i * d1
frmMain.imgIcon(i).Visible = True
Next
For i = nIcon To nMaxIcon - 1
frmMain.imgIcon(i).Left = IconX1 + i * d1
frmMain.imgIcon(i).Visible = False
Next
' 显示硬币
If n1Yuan > 0 Then
frmMain.img1Yuan(0).Visible = True
Else
frmMain.img1Yuan(0).Visible = False
End If
For i = 1 To n1Yuan - 1
Load frmMain.img1Yuan(i)
frmMain.img1Yuan(i).Left = IconX1 + i * d2
frmMain.img1Yuan(i).Visible = True
frmMain.img1Yuan(i).ZOrder 0 ' 控件置前
Next
nShowed1Yuan = n1Yuan ' 记录已显示的硬币数
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -