机房收费系统（四）

最新推荐文章于 2021-02-24 07:50:13 发布

前端帅气小哥哥

最新推荐文章于 2021-02-24 07:50:13 发布

阅读量461

点赞数 1

分类专栏：编程语言数据库

本文链接：https://blog.csdn.net/FutureLifes/article/details/79188881

版权

编程语言同时被 2 个专栏收录

23 篇文章 0 订阅

订阅专栏

数据库

7 篇文章 0 订阅

订阅专栏

最近机房收费系统进入最后的冲刺期了。机房收费系统之中最核心的部分就是上下机按钮了，一开始我总是感觉到很头晕，不知道应该怎么样去设计这两个按钮的代码，但是在很多同学的帮助之下，我最终理清楚了逻辑，完成了这两个按钮的设计。

这两个按钮的设计有着异曲同工之妙，形成了一个闭合的循环，借助这两张思维导图，帮我理清楚了这两个按钮的逻辑。两个按钮的前面几个步骤很相似，但是下机按钮少了判断卡号是否可以使用，因为判断了可以使用才能上机，所以没必要再一次判断卡号是否可以使用。下机按钮在后面的步骤会更加多一点，因为要判断消费金额，

Private Sub cmdOffline_Click()
    
    Dim txtSQL As String
    Dim MsgText As String
    Dim mrc As ADODB.Recordset   'student_info
    Dim mrc1 As ADODB.Recordset  'bascidata_info
    Dim mrc2 As ADODB.Recordset  'line_info
    Dim mrc3 As ADODB.Recordset  'online_info
    
    '卡号是否为空
    If txtCardno = "" Then
        MsgBox "请输入卡号!", vbOKOnly, "提示"
        txtCardno.SetFocus
        txtCardno = ""
        Exit Sub
    End If
    
    '卡号是否存在
    txtSQL = "select * from student_Info where cardno='" & Trim(txtCardno.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.EOF Then
        MsgBox "不存在该卡号！", vbOKOnly, "提示"
        txtCardno.SetFocus
        txtCardno = ""
        Exit Sub
    End If
    
    '卡号是否正在上机
    txtSQL = "select * from OnLine_Info where cardno='" & Trim(txtCardno.Text) & "'"
    Set mrc3 = ExecuteSQL(txtSQL, MsgText)
    If mrc3.EOF Then
        MsgBox "该用户未上机！", vbOKOnly, "提示"
        txtCardno.SetFocus
        txtCardno = ""
        txtType.Text = ""
        txtStudentno.Text = ""
        txtName.Text = ""
        txtDepartment.Text = ""
        comboSex.Text = ""
        txtOnlinedate.Text = ""
        txtOnlinetime.Text = ""
        txtOfflinedate.Text = ""
        txtOfflinetime.Text = ""
        txtTime.Text = ""
        txtRemaincash.Text = ""
        txtUsedcash.Text = ""
        Exit Sub
    End If
    
    '更新界面信息
    txtType.Text = Trim(mrc3.Fields(1))
    txtStudentno.Text = Trim(mrc3.Fields(2))
    txtName.Text = Trim(mrc3.Fields(3))
    txtDepartment.Text = Trim(mrc3.Fields(4))
    comboSex.Text = Trim(mrc3.Fields(5))
    txtOnlinedate.Text = Trim(mrc3.Fields(6))
    txtOnlinetime.Text = Trim(mrc3.Fields(7))
    txtOfflinedate.Text = Trim(Date)
    txtOfflinetime.Text = Trim(Time)
    txtTime.Text = Trim(DateDiff("n", Trim(txtOnlinetime.Text), Trim(Time))) '把时间差转换为分钟
    
        
    '从基本数据表获取数据
    txtSQL = "select * from BasicData_Info "
    Set mrc1 = ExecuteSQL(txtSQL, MsgText)
    
    '计算消费金额
    Dim MinTime As Integer
    Dim AllTime As Single
    Dim Rate As Single
    Dim Money As Integer
    
    MinTime = mrc1.Fields(3)
    AllTime = txtTime.Text
    
    '上机时间小于准备时间，不算时间,不花钱
    If Trim(txtTime.Text) < MinTime Then
        txtTime.Text = 0 & ""
        Money = 0
    Else
        If AllTime > MinTime Then
            Do While AllTime > MinTime
                AllTime = AllTime - 30
                If mrc.Fields(14) = "固定用户" Then
                    Money = Money + 2
                Else
                    Money = Money + 3
                End If
            Loop
         End If
     End If
     txtUsedcash.Text = Money
        
    '计算余额
    txtSQL = "select * from student_Info where cardno='" & Trim(txtCardno.Text) & "'and status='" & "使用" & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    
    txtRemaincash.Text = Val(Trim(mrc.Fields(7))) - Val(Trim(txtUsedcash.Text))
    
    txtSQL = "Update student_Info set cash='" & Trim(txtUsedcash.Text) & "' where cardno='" & Trim(txtCardno.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    
    MsgBox "下机成功！", vbOKOnly, "提示"
    
    '更新Line表
    txtSQL = "select * from Line_Info "
    Set mrc2 = ExecuteSQL(txtSQL, MsgText)
    
    If Not mrc2.EOF Then
        mrc2.AddNew
        mrc2.Fields(1) = Trim(txtCardno.Text)
        mrc2.Fields(2) = Trim(txtStudentno.Text)
        mrc2.Fields(3) = Trim(txtName.Text)
        mrc2.Fields(4) = Trim(txtDepartment.Text)
        mrc2.Fields(5) = Trim(comboSex.Text)
        mrc2.Fields(6) = Trim(txtOnlinedate.Text)
        mrc2.Fields(7) = Trim(txtOnlinetime.Text)
        mrc2.Fields(8) = Trim(txtOfflinedate.Text)
        mrc2.Fields(9) = Trim(txtOfflinetime.Text)
        mrc2.Fields(10) = Trim(txtTime.Text)
        mrc2.Fields(11) = Trim(txtUsedcash.Text)
        mrc2.Fields(12) = Trim(txtRemaincash.Text)
        mrc2.Fields(13) = "正常下机"
        mrc2.Fields(14) = Trim(Environ("computername"))
        mrc2.Update
        mrc2.Close
    End If
    
    mrc3.Delete
        
    '更新上机人数
    txtSQL = "select count(*) from OnLine_Info "
    Set mrc3 = ExecuteSQL(txtSQL, MsgText)
    Label15.Caption = "当前上机人数为：" & Trim(mrc3.RecordCount)
    
End Sub

Private Sub cmdOnline_Click()
    
    Dim txtSQL As String
    Dim MsgText As String
    Dim mrc As ADODB.Recordset
    Dim mrc1 As ADODB.Recordset    'OnLine_Info
    Dim mrc2 As ADODB.Recordset    'Line_Info
    Dim mrc3 As ADODB.Recordset    'Basicdata_Info
    Dim miCount As Integer
    
    txtType.Text = ""
    txtStudentno.Text = ""
    txtName.Text = ""
    txtDepartment.Text = ""
    comboSex.Text = ""
    txtOnlinedate.Text = ""
    txtOnlinetime.Text = ""
    txtOfflinedate.Text = ""
    txtOfflinetime.Text = ""
    txtTime.Text = ""
    txtRemaincash.Text = ""
    txtUsedcash.Text = ""
    
    '卡号是否为空
    If txtCardno = "" Then
        MsgBox "请输入卡号!", vbOKOnly, "提示"
        txtCardno.SetFocus
        txtCardno = ""
        Exit Sub
    End If
    
    '卡号是否注册
    txtSQL = "select * from student_Info where cardno='" & Trim(txtCardno.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.EOF Then
        MsgBox "该卡号尚未注册，请重新输入！", vbOKOnly, "提示"
        txtCardno.SetFocus
        txtCardno = ""
        Exit Sub
    End If
    
    '卡号是否在上机
    txtSQL = "select * from OnLine_Info where cardno='" & Trim(txtCardno.Text) & "'"
    Set mrc1 = ExecuteSQL(txtSQL, MsgText)
    If mrc1.EOF = False Then
        MsgBox "该卡号正在上机！", vbOKOnly, "提示"
        txtCardno = ""
        txtCardno.SetFocus
        txtType.Text = ""
        txtStudentno.Text = ""
        txtName.Text = ""
        txtDepartment.Text = ""
        comboSex.Text = ""
        txtOnlinedate.Text = ""
        txtOnlinetime.Text = ""
        txtOfflinedate.Text = ""
        txtOfflinetime.Text = ""
        txtTime.Text = ""
        txtRemaincash.Text = ""
        txtUsedcash.Text = ""
        Exit Sub
        
    End If
    
    '卡号是否余额不足
    If mrc.Fields(7) <= 5 Then
        If MsgBox("该卡号余额不足，是否充值？", vbOKCancel, "提示") = vbOK Then
            frmrecharge.Show , Me
        End If
        Exit Sub
    End If

    
    '卡号使用状态
    If mrc.Fields(10) = "未使用" Then
        If MsgBox("该卡尚未激活，是否修改学生信息？", vbOKCancel, "提示") = vbOK Then
            frmmodifysinfo.Show , Me
        End If
        Exit Sub
    End If

    '是否设定基础数据
    txtSQL = "select * from basicdata_Info"
    Set mrc3 = ExecuteSQL(txtSQL, MsgText)
    If mrc3.EOF Then
        If MsgBox("该卡尚未设定基础数据，无法登录，是否设定？", vbOKCancel, "提示") = vbOK Then
            frmsetbasicdata.Show , Me
        End If
        Exit Sub
    End If
    
    '上机成功，更新上机界面信息
    txtSQL = "select * from student_Info where cardno='" & Trim(txtCardno.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    '显示数据
    txtStudentno.Text = Trim(mrc.Fields(1))
    txtDepartment.Text = Trim(mrc.Fields(4))
    txtType.Text = Trim(mrc.Fields(14))
    txtName.Text = Trim(mrc.Fields(2))
    comboSex.Text = Trim(mrc.Fields(3))
    txtOnlinedate.Text = Trim(Date)
    txtOnlinetime.Text = Trim(Time)
    txtRemaincash.Text = Val(Trim(mrc.Fields(7)))
    
    '更新上机表信息
    txtSQL = "select * from OnLine_Info"
    Set mrc1 = ExecuteSQL(txtSQL, MsgText)
    
    mrc1.AddNew
    mrc1.Fields(0) = Trim(txtCardno.Text)
    mrc1.Fields(1) = Trim(txtType.Text)
    mrc1.Fields(2) = Trim(txtStudentno.Text)
    mrc1.Fields(3) = Trim(txtName.Text)
    mrc1.Fields(4) = Trim(txtDepartment.Text)
    mrc1.Fields(5) = Trim(comboSex.Text)
    mrc1.Fields(6) = Trim(txtOnlinedate.Text)
    mrc1.Fields(7) = Trim(txtOnlinetime.Text)
    mrc1.Fields(8) = Trim("ZOEY")
    mrc1.Fields(9) = Trim(Date)
    mrc1.Update
    lblOnlineNum.Caption = mrc1.RecordCount
    '显示当前上机人数
    mrc1.Close
    
    '增加上机记录
    txtSQL = "select * from Line_Info"
    Set mrc2 = ExecuteSQL(txtSQL, MsgText)
    mrc2.AddNew
    mrc2.Fields(1) = Trim(txtCardno.Text)
    mrc2.Fields(2) = Trim(txtStudentno.Text)
    mrc2.Fields(3) = Trim(txtName.Text)
    mrc2.Fields(4) = Trim(txtDepartment.Text)
    mrc2.Fields(5) = Trim(comboSex.Text)
    mrc2.Fields(6) = Trim(txtOnlinedate.Text)
    mrc2.Fields(7) = Trim(txtOnlinetime.Text)
    mrc2.Fields(13) = Trim("正常上机")
    mrc2.Fields(14) = Trim("ZOEY")
    mrc2.Update
    mrc2.Close
    
    '更新上机人数
    txtSQL = "select count(*) from OnLine_Info "
    Set mrc1 = ExecuteSQL(txtSQL, MsgText)
    
    Label15.Caption = "当前上机人数为：" & Trim(mrc1.RecordCount + 1)
    
End Sub

整个代码的设计是我借助了很多同学的帮助才能完成，在这里向那些帮助过我的同学表示感谢，没有你们就没有我的今天。