机房收费系统之上下机

前端之家收集整理的这篇文章主要介绍了机房收费系统之上下机前端之家小编觉得挺不错的,现在分享给大家,也给大家做个参考。

一、前言

完成了机房收费系统后,觉得之前的逻辑图只有大构架,一些细节还是不够清晰,于是回过头来,重新整理了一下上下机逻辑图,顺便晒下代码

二、内容

1、上机逻辑图

2、上机代码

Private Sub cmdUp_Click()
    txtDate.Text = ""
    txtTime.Text = ""
    txtDistime.Text = ""
    txtDiscash.Text = ""

'是否为空
    If Not TxTe(txtCardNo.Text) Then
        MsgBox "请您输入上机卡号!",vbOKOnly + 48,"提示"
        txtCardNo.SetFocus
        txtCardNo.Text = ""
        Exit Sub
    End If
'是否在线
    txtsql = "select*from online_info where cardno='" & txtCardNo.Text & "'"
    Set mrc = Executesql(txtsql,MsgText)
    If mrc.EOF = False Then
        MsgBox "该卡已经上机!","提示"
        txtCardNo.SetFocus
        txtCardNo.Text = ""
        Exit Sub
        mrc.Close
    End If
'判断有无该卡号
    txtsql = "select*from student_info where cardno='" & txtCardNo.Text & "'"
    Set mrc = Executesql(txtsql,MsgText)
    If mrc.EOF Then
        MsgBox "无该卡号,请重新输入!","提示"
        txtCardNo.SetFocus
        txtCardNo.Text = ""
        Exit Sub
    End If
'是否使用状态
    If mrc.Fields(8) = "未使用" Then
        If MsgBox("该卡未激活!是否修改学生信息?",vbOKCancel,"提示") = vbOK Then
            frmInformation.Show,Me
        End If
        Exit Sub
    End If
'是否有余额
    If mrc.Fields(1) <= 0 Then
        If MsgBox("该卡号余额不足,是否前往充值?","提示") = vbOK Then
            frmRecharge.Show,Me
        End If
        Exit Sub
    End If
    mrc.Close
'是否设定基础数据
    txtsql = "select*from basicdata_info"
    Set mrc = Executesql(txtsql,MsgText)
    If mrc.EOF Then
        If MsgBox("未设定基础数据,无法登陆,是否前往设定?","提示") = vbOK Then
            frmSetting.Show,Me
        End If
        Exit Sub
    End If
    mrc.Close
'更新上机界面信息
    '提取学生表
    txtsql = "select*from student_info where cardno='" & txtCardNo.Text & "'"
    Set mrc = Executesql(txtsql,MsgText)
    
    txtStudentNo.Text = Trim(mrc.Fields(4))
    txtType.Text = Trim(mrc.Fields(9))
    txtCash.Text = Trim(mrc.Fields(1))
    txtStudentName.Text = Trim(mrc.Fields(2))
    txtDepartment.Text = Trim(mrc.Fields(5))
    txtSex.Text = Trim(mrc.Fields(3))
    txtOnDate.Text = Trim(Date)
    txtOnTime.Text = Trim(Time)
    
'更新上机表信息
    Dim bas As ADODB.Recordset
    Dim bsql As String,bMsg As String
    '提取上机表和基础数据表
    txtsql = "select*from online_info"
    Set mrc = Executesql(txtsql,MsgText)
    bsql = "select*from basicdata_info"
    Set bas = Executesql(bsql,bMsg)

    mrc.AddNew
    mrc.Fields(0) = Trim(txtCardNo.Text)
    mrc.Fields(1) = Trim(txtType.Text)
    mrc.Fields(2) = Trim(txtStudentNo.Text)
    mrc.Fields(3) = Trim(txtStudentName.Text)
    mrc.Fields(4) = Trim(txtSex.Text)
    mrc.Fields(5) = Trim(txtDepartment.Text)
    mrc.Fields(6) = Trim(txtOnDate.Text)
    mrc.Fields(7) = Trim(txtOnTime.Text)
    mrc.Fields(8) = Trim(PCName)
    mrc.Fields(9) = Now

    mrc.Fields(10) = Trim(txtCash.Text)
    mrc.Fields(11) = 1
    '用户消费方式
    If txtType.Text = "固定会员" Then
        mrc.Fields(12) = Val(Trim(bas.Fields(0)))
    Else
        If txtType.Text = "临时用户" Then
            mrc.Fields(12) = Val(Trim(bas.Fields(1)))
        Else
            MsgBox "该卡号未设定用户类型,登陆失败!",vbOKOnly,"提示"
            Exit Sub
        End If
    End If
    mrc.Update
    txtCardNo.SetFocus
    txtCardNo.Text = ""

'更新上机人数
    txtsql = "select*from online_info"
    Set mrc = Executesql(txtsql,MsgText)
    LoginNumber.Caption = "当前上机人数为:" & mrc.RecordCount
    mrc.Close
End Sub

3、扣费

有关扣费请观阅: 机房收费系统之上机扣费

4、下机逻辑图

5、下机代码

Private Sub cmdDown_Click()
'是否为空
    If Not TxTe(txtCardNo.Text) Then
        MsgBox "请您输入下机卡号!",MsgText)
    If mrc.EOF Then
        MsgBox "用户未上机。","提示"
        txtCardNo.SetFocus
        txtCardNo.Text = ""
        Exit Sub
    End If
    
'更新界面信息
    txtStudentNo.Text = Trim(mrc.Fields(2))
    txtType.Text = Trim(mrc.Fields(1))
    txtStudentName.Text = Trim(mrc.Fields(3))
    txtDepartment.Text = Trim(mrc.Fields(5))
    txtSex.Text = Trim(mrc.Fields(4))
    txtOnDate.Text = Trim(mrc.Fields(6))
    txtOnTime.Text = Trim(mrc.Fields(7))
    txtcash.Text = Trim(mrc.Fields(10))
    txtDistime.Text = Trim(mrc.Fields(11))
    txtDate.Text = Date
    txtTime.Text = Time
    '更新Online表数据
    mrc.Delete
    mrc.Close
    '计算消费金额
    txtsql = "select*from student_info where cardno='" & txtCardNo.Text & "'"
    Set mrc = Executesql(txtsql,MsgText)
    txtDiscash.Text = Val(Trim(mrc.Fields(1))) - Val(Trim(txtcash.Text))
    mrc.Close
'更新下机信息
    Dim STD As ADODB.Recordset
    Dim tsql As String,mText As String
    '提取学生表和下线表
    tsql = "select*from student_info where cardno='" & txtCardNo.Text & "'"
    Set STD = Executesql(tsql,mText)
    txtsql = "select*from line_info order by serial desc"
    Set mrc = Executesql(txtsql,MsgText)
    
    '写入数据
    mrc.AddNew
    mrc.Fields(1) = Trim(txtCardNo.Text)
    mrc.Fields(2) = Trim(txtStudentNo.Text)
    mrc.Fields(3) = Trim(txtStudentName.Text)
    mrc.Fields(4) = Trim(txtDepartment.Text)
    mrc.Fields(5) = Trim(txtSex.Text)
    mrc.Fields(6) = Trim(txtOnDate.Text)
    mrc.Fields(7) = Trim(txtOnTime.Text)
    mrc.Fields(8) = Trim(txtDate.Text)
    mrc.Fields(9) = Trim(txtTime.Text)
    mrc.Fields(10) = Trim(txtDistime.Text)
    mrc.Fields(11) = Trim(txtDiscash.Text)
    mrc.Fields(12) = Trim(txtcash.Text)
    mrc.Fields(14) = Trim(PCName)
    STD.Fields(1) = Trim(txtcash.Text)
    '学生卡状态
    If Trim(STD.Fields(8)) = "使用" Then
        mrc.Fields(13) = Trim("使用")
    Else
        mrc.Fields(13) = Trim("未使用")
    End If
    mrc.Update
    STD.Update
    STD.Close
    mrc.Close
'更新上机人数
    txtsql = "select*from online_info"
    Set mrc = Executesql(txtsql,MsgText)
    LoginNumber.Caption = "当前上机人数为:" & mrc.RecordCount
    mrc.Close
End Sub


三、总结

做项目前,做好产品逻辑构造,可以起到事半功倍的作用,大构架掌控的是方向,而模块逻辑把控的是产品质量,每一次锻炼,都让我在待人待物上得到很大的提升。

猜你在找的VB相关文章