⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 module1.bas

📁 广州地铁一、二号线自动售票机模拟程序 VB
💻 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 + -