第一次机房收费系统之上下机界面

最新推荐文章于 2021-03-10 15:41:39 发布

追寻_无憾

最新推荐文章于 2021-03-10 15:41:39 发布

阅读量215

点赞数

分类专栏： VB

本文链接：https://blog.csdn.net/TGB__15__ZYB/article/details/97616649

版权

VB 专栏收录该内容

29 篇文章 0 订阅

订阅专栏

上下机界面流程如下：

上机：
输入卡号-----判断是否输入（否提示请输入卡号）-----连接student_info、online_info和line_info表-----进行数据比对-----满足条件的上机
下机：
输入卡号-----判断是否输入（否提示请输入卡号）-----连接student_info、online_info和line_info表-----进行数据比对-----满足条件下机
退出系统：
点击右上方×-----连接user_info、onwork_info和worklog_info表-----数据比对-----退出系统

上下机界面用到的数据表：

student_info（存放学生信息）
online_info（判断是否上机）
line_info（存放上下机记录）
user_info（存放用户记录）
onwork_info（判断是否登录）
worklog_info（存放登录退出系统的记录）
basicdata_info（定义单价、最低上机时间等等）

本界面的操作的内容：

上机：
输入卡号，与student_info表进行比对，看是否存在此信息。若不存在提示此卡号不存在。若存在，再与online_info表比对，看是否已经上机，若已上机提示已上机，如未上机则上机并将信息更新到online_info和line_info两表中。
下机：
输入卡号，与student_info表比对，看是否存在此信息，若不存在提示此卡号不存在，否则与online_info表比对，是否存在此卡号，若不存在提示已下机，否则删除online_info表中的记录，将下机的时间、日期、花费时间、金额等更新到line_info表中，将余额更新到studeng_info中。
退出系统：
点击右上角的×，提示是否退出，点击“否”放弃操作，否则删除onwork_info表中的对应数据，将退出时间、日期等更新到worklog_info表中

具体代码如下：

上机的操作：

Private Sub cmdON_Click()
    '对student_info表的操作
    Dim mrcstudent As ADODB.Recordset '用于存放记录集
    Dim studentSQL As String '用于存放SQL语句
    Dim stuMsgText As String '用于存放返回信息
    '对BasicData_Info表的操作
    Dim mrcbasicdata As ADODB.Recordset '用于存放记录集
    Dim basicdataSQL As String '用于存放SQL语句
    Dim basicdataMsgText As String '用于存放返回信息
    '对Online_info表的操作
    Dim mrconline As ADODB.Recordset '用于存放记录集
    Dim onlineSQL As String '用于存放SQL语句
    Dim onlineMsgText As String '用于存放返回信息
    '对line_info 表的操作
    Dim mrcline As ADODB.Recordset '用于存放记录集
    Dim lineSQL As String '用于存放SQL语句
    Dim lineMsgText As String '用于存放返回信息
    
    '判断卡号是否为空
    If Trim(txtCID.Text) = "" Then
        MsgBox "请输入卡号！", vbOKOnly + vbExclamation, "警告"
        txtCID.SetFocus
        Exit Sub
    Else
        '清空文本框内容
        txtSID.Text = ""
        txtBalance.Text = ""
        txtSex.Text = ""
        txtType.Text = ""
        txtStudentName.Text = ""
        txtDepartment.Text = ""
        txtOnDate.Text = ""
        txtOnTime.Text = ""
        txtOffDate.Text = ""
        txtOffTime.Text = ""
        txtCMoney.Text = ""
        txtCTime.Text = ""
        
        lineSQL = "select * from line_info"
        Set mrcline = ExecuteSQL(lineSQL, lineMsgText)
        
        studentSQL = "select * from student_Info where cardno='" & Trim(txtCID.Text) & "'"
        Set mrcstudent = ExecuteSQL(studentSQL, stuMsgText)
        
        basicdataSQL = "select * from BasicData_Info "
        Set mrcbasicdata = ExecuteSQL(basicdataSQL, basicdataMsgText)
        
        '根据记录是否存在判断是否存在此卡号
        If mrcstudent.EOF Then
            MsgBox "没有此卡号，请重新输入！", vbOKCancel + vbQuestion, "提示"
            txtCID.Text = ""
            mrcstudent.Close
            Exit Sub
        Else
            '判断是否此卡处于使用状态
            If Not mrcstudent.EOF And mrcstudent.Fields(10) = "未使用" Then
                MsgBox "此卡未使用，无法上机！", vbOKCancel + vbQuestion, "提示"
                txtCID.Text = ""
                mrcstudent.Close
                Exit Sub
            Else
                '判断余额是否低于最小限制金额
                If Val(mrcstudent.Fields(7)) < Val(mrcbasicdata.Fields(5)) Then
                    MsgBox "余额不足，请及时充值！", vbOKCancel + vbQuestion, "提示"
                    txtCID.Text = ""
                    mrcstudent.Close
                    mrcbasicdata.Close
                    Exit Sub
                Else
                    onlineSQL = "select * from OnLine_info where cardno='" & Trim(txtCID.Text) & "'"
                    Set mrconline = ExecuteSQL(onlineSQL, onlineMsgText)
                    If Not mrconline.EOF Then
                        MsgBox "此卡正在上机！", vbOKCancel + vbQuestion, "提示"
                        txtCID.Text = ""
                        mrconline.Close
                        Exit Sub
                    Else
                        '更新界面
                        txtSID.Text = mrcstudent.Fields(1)
                        txtStudentName.Text = mrcstudent.Fields(2)
                        txtSex.Text = mrcstudent.Fields(3)
                        txtType.Text = mrcstudent.Fields(14)
                        txtBalance.Text = mrcstudent.Fields(7)
                        txtDepartment.Text = mrcstudent.Fields(4)
                        txtOnDate.Text = Date
                        txtOnTime.Text = Time
                        mrcstudent.Close
                        '更新OnLine_info表，添加新记录
                        mrconline.AddNew
                        mrconline.Fields(0) = Trim(txtCID.Text)
                        mrconline.Fields(1) = Trim(txtType.Text)
                        mrconline.Fields(2) = Trim(txtSID.Text)
                        mrconline.Fields(3) = Trim(txtStudentName.Text)
                        mrconline.Fields(4) = Trim(txtDepartment.Text)
                        mrconline.Fields(5) = Trim(txtSex.Text)
                        mrconline.Fields(6) = Trim(txtOnDate.Text)
                        mrconline.Fields(7) = Trim(txtOnTime.Text)
                        mrconline.Fields(8) = Trim(VBA.Environ("computername")) '当前计算机用户的名字
                        mrconline.Fields(9) = Trim(Date + Time)
                        mrconline.Update
                        mrconline.Close
                        '更新Line_info表，添加新记录
                        mrcline.AddNew
                        mrcline.Fields(1) = Trim(txtCID.Text)
                        mrcline.Fields(2) = Trim(txtSID.Text)
                        mrcline.Fields(3) = Trim(txtStudentName.Text)
                        mrcline.Fields(4) = Trim(txtDepartment.Text)
                        mrcline.Fields(5) = Trim(txtSex.Text)
                        mrcline.Fields(6) = Trim(txtOnDate.Text)
                        mrcline.Fields(7) = Trim(txtOnTime.Text)
                        mrcline.Fields(13) = "正常上机"
                        mrcline.Fields(14) = Trim(VBA.Environ("computername"))
                        mrcline.Update
                        mrcline.Close
                        '显示上机人数
                        onlineSQL = "select * from OnLine_info"
                        Set mrconline = ExecuteSQL(onlineSQL, onlineMsgText)
                        If mrconline.EOF Then
                            lblNOWPeople.Caption = 0
                        Else
                            lblNOWPeople.Caption = mrconline.RecordCount '计算上机总人数
                        End If
                    End If
                End If
            End If
        End If
        MsgBox "此卡已成功上机！", vbOKOnly + vbExclamation, "提示"
        txtCID.SetFocus
    End If
End Sub

下机的操作：

Private Sub cmdOFF_Click()
    Dim ADDTime As String
    '对Online_info表的操作
    Dim mrconline As ADODB.Recordset '用于存放记录集
    Dim onlineSQL As String '用于存放SQL语句
    Dim onlineMsgText As String '用于存放返回信息
    '对student_info表操作
    Dim mrcstudent As ADODB.Recordset '用于存放记录集
    Dim studentSQL As String '用于存放SQL语句
    Dim studentMsgText As String '用于存放返回信息
    '对basic_info表操作
    Dim mrcbasic As ADODB.Recordset '用于存放记录集
    Dim basicSQL As String '用于存放SQL语句
    Dim basicMsgText As String '用于存放返回信息
    '对Line_info表操作
    Dim mrcline As ADODB.Recordset '用于存放记录集
    Dim lineSQL As String '用于存放SQL语句
    Dim lineMsgText As String '用于存放返回信息
    
    '判断卡号是否为空
    If Trim(txtCID.Text) = "" Then
        MsgBox "请输入卡号！", vbOKCancel + vbQuestion, "提示"
    Else
    
        onlineSQL = "select * from OnLine_Info where cardno='" & Trim(txtCID.Text) & "'"
        Set mrconline = ExecuteSQL(onlineSQL, onlineMsgText)
        
        studentSQL = "select * from student_info where cardno='" & Trim(txtCID.Text) & "'"
        Set mrcstudent = ExecuteSQL(studentSQL, studentMsgText)
        
        basicSQL = "select * from basicdata_info"
        Set mrcbasic = ExecuteSQL(basicSQL, basicMsgText)
        
        '判断是否存在上机记录
        If mrconline.EOF Then
            MsgBox "此卡没有上机，请仔细检查！", vbOKCancel + vbQuestion, "提示"
            txtCID.Text = ""
            mrconline.Close
            Exit Sub
        Else
            '判断是否注册此卡
            If mrcstudent.EOF Then
                MsgBox "此卡没有注册，请仔细检查！", vbOKCancel + vbQuestion, "提示"
                txtCID.Text = ""
                mrconline.Close
                Exit Sub
            Else
                '更新下机界面的数据
                txtSID.Text = mrconline.Fields(2)
                txtStudentName.Text = mrconline.Fields(3)
                txtSex.Text = mrconline.Fields(5)
                txtType.Text = mrconline.Fields(1)
                txtDepartment.Text = mrconline.Fields(4)
                txtOnDate.Text = mrconline.Fields(6)
                txtOnTime.Text = mrconline.Fields(7)
                txtOffDate.Text = Date
                txtOffTime.Text = Time
                '当上机日期大于下机日期时禁止下机，防止改日期
                If CDate(txtOnDate.Text) > CDate(txtOffDate.Text) Then
                    MsgBox "日期错误，无法下机！", vbOKOnly + vbExclamation, "警告"
                    txtBalance.Text = ""
                    txtCID.Text = ""
                    txtSID.Text = ""
                    txtSex.Text = ""
                    txtType.Text = ""
                    txtStudentName.Text = ""
                    txtDepartment.Text = ""
                    txtOnDate.Text = ""
                    txtOnTime.Text = ""
                    txtOffDate.Text = ""
                    txtOffTime.Text = ""
                    txtCMoney.Text = ""
                    txtCTime.Text = ""
                    txtCID.SetFocus
                    mrconline.Close
                    mrcstudent.Close
                    mrcbasic.Close
                    Exit Sub
                Else
                    '判断当日期相等时间错误时
                    If CDate(txtOnDate.Text) = CDate(txtOffDate.Text) Then
                        If Format(txtOnTime.Text, "hh:mm:ss") > Format(txtOffTime.Text, "hh:mm:ss") Then
                            MsgBox "时间错误，无法下机！", vbOKOnly + vbExclamation, "警告"
                            txtBalance.Text = ""
                            txtCID.Text = ""
                            txtSID.Text = ""
                            txtSex.Text = ""
                            txtType.Text = ""
                            txtStudentName.Text = ""
                            txtDepartment.Text = ""
                            txtOnDate.Text = ""
                            txtOnTime.Text = ""
                            txtOffDate.Text = ""
                            txtOffTime.Text = ""
                            txtCMoney.Text = ""
                            txtCTime.Text = ""
                            txtCID.SetFocus
                            mrconline.Close
                            mrcstudent.Close
                            mrcbasic.Close
                            Exit Sub
                        Else
                            '时间正确时继续操作下机
                            'abs()函数时绝对值函数；datediff（"单位",日期1,日期2）计算时间差；val（）函数字符转数字型
                            ADDTime = Abs(Val(DateDiff("n", Trim(mrconline.Fields(9)), Now)))
                            txtCTime.Text = ADDTime
                            '上机时间小于最低上机时间
                            If ADDTime < Val(mrcbasic.Fields(4)) Then
                                txtCTime.Text = "0"
                                txtCMoney.Text = "0"
                                txtBalance.Text = Trim(mrcstudent.Fields(7))
                            End If
                            '上机大于最低上机时间小于单位时间
                            If ADDTime < Val(mrcbasic.Fields(3)) Then
                                txtCMoney.Text = "1"
                                txtBalance.Text = Val(mrcstudent.Fields(7)) - Val(txtCMoney.Text)
                            End If
                            '不同用户收费不同
                            If mrconline.Fields(1) = "固定用户" Then
                                'round（）四舍五入保留两位小数；cdbl（）将string转换为double类型
                                txtCMoney.Text = Round(CDbl(ADDTime) * mrcbasic.Fields(0) / 60)
                                txtBalance.Text = Val(mrcstudent.Fields(7)) - Val(txtCMoney.Text)
                            Else
                                txtCMoney.Text = Round(CDbl(ADDTime) * mrcbasic.Fields(1) / 60)
                                txtBalance.Text = Val(mrcstudent.Fields(7)) - Val(txtCMoney.Text)
                            End If
                            '余额不足禁止下机
                            If Val(txtBalance.Text) < 0 Then
                                MsgBox "此卡余额不足，请先充值！", vbOKCancel + vbQuestion, "提示"
                                txtBalance.Text = ""
                                txtCID.Text = ""
                                txtSID.Text = ""
                                txtSex.Text = ""
                                txtType.Text = ""
                                txtStudentName.Text = ""
                                txtDepartment.Text = ""
                                txtOnDate.Text = ""
                                txtOnTime.Text = ""
                                txtOffDate.Text = ""
                                txtOffTime.Text = ""
                                txtCMoney.Text = ""
                                txtCTime.Text = ""
                                mrcstudent.Close
                                mrconline.Close
                                mrcbasic.Close
                                Exit Sub
                            Else
                                mrcstudent.Fields(7) = Trim(txtBalance.Text)
                                mrcstudent.Fields(11) = "未结账"
                                mrcstudent.Update
                                lineSQL = "select * from Line_Info where cardno='" & Trim(txtCID.Text) & "' and ondate='" & Trim(txtOnDate.Text) & "' and ontime='" & Trim(txtOnTime.Text) & "'"
                                Set mrcline = ExecuteSQL(lineSQL, lineMsgText)
                                '判断是否存在上机记录
                                If mrcline.EOF Then
                                    MsgBox "该用户没有上机记录，请仔细确认！", vbOKCancel + vbQuestion, "提示"
                                    txtBalance.Text = ""
                                    txtCID.Text = ""
                                    txtSID.Text = ""
                                    txtSex.Text = ""
                                    txtType.Text = ""
                                    txtStudentName.Text = ""
                                    txtDepartment.Text = ""
                                    txtOnDate.Text = ""
                                    txtOnTime.Text = ""
                                    txtOffDate.Text = ""
                                    txtOffTime.Text = ""
                                    txtCMoney.Text = ""
                                    txtCTime.Text = ""
                                    mrcline.Close
                                    Exit Sub
                                Else
                                    '更新数据表line_info
                                    mrcline.Fields(8) = Date
                                    mrcline.Fields(9) = Time
                                    mrcline.Fields(10) = ADDTime
                                    mrcline.Fields(11) = Trim(txtCMoney.Text)
                                    mrcline.Fields(12) = Trim(txtBalance.Text)
                                    mrcline.Fields(13) = "正常下机"
                                    mrcline.Update
                                    mrcline.Close
                                    mrconline.Delete
                                End If
                                mrcstudent.Close
                                mrconline.Close
                                mrcbasic.Close
                            End If
                        End If
                    Else
                        '上机日期小于下机日期即日期正确时
                        'abs()函数时绝对值函数；datediff（"单位",日期1,日期2）计算时间差；val（）函数字符转数字型
                        ADDTime = Abs(Val(DateDiff("n", Trim(mrconline.Fields(9)), Now)))
                        txtCTime.Text = ADDTime
                        '上机时间小于最低上机时间
                        If ADDTime < Val(mrcbasic.Fields(4)) Then
                            txtCTime.Text = "0"
                            txtCMoney.Text = "0"
                            txtBalance.Text = Trim(mrcstudent.Fields(7))
                        End If
                        '判断上机时间大于上机时间小于单位时间
                        If ADDTime < Val(mrcbasic.Fields(3)) Then
                            txtCMoney.Text = "1"
                            txtBalance.Text = Val(mrcstudent.Fields(7)) - Val(txtCMoney.Text)
                        End If
                        '不同用户进行不同的收费
                        If mrconline.Fields(1) = "固定用户" Then
                            'round（）四舍五入保留两位小数；cdbl（）将string转换为double类型
                            txtCMoney.Text = Round(CDbl(ADDTime) * mrcbasic.Fields(0) / 60)
                            txtBalance.Text = Val(mrcstudent.Fields(7)) - Val(txtCMoney.Text)
                        Else
                            txtCMoney.Text = Round(CDbl(ADDTime) * mrcbasic.Fields(1) / 60)
                            txtBalance.Text = Val(mrcstudent.Fields(7)) - Val(txtCMoney.Text)
                        End If
                        '判断余额是否不足，不足时禁止下机
                        If Val(txtBalance.Text) < 0 Then
                            MsgBox "此卡余额不足，请先充值！", vbOKCancel + vbQuestion, "提示"
                            txtBalance.Text = ""
                            txtCID.Text = ""
                            txtSID.Text = ""
                            txtSex.Text = ""
                            txtType.Text = ""
                            txtStudentName.Text = ""
                            txtDepartment.Text = ""
                            txtOnDate.Text = ""
                            txtOnTime.Text = ""
                            txtOffDate.Text = ""
                            txtOffTime.Text = ""
                            txtCMoney.Text = ""
                            txtCTime.Text = ""
                            mrcstudent.Close
                            mrconline.Close
                            mrcbasic.Close
                            Exit Sub
                        Else
                            '更新数据表student_info
                            mrcstudent.Fields(7) = Trim(txtBalance.Text)
                            mrcstudent.Fields(11) = "未结账"
                            mrcstudent.Update
                            lineSQL = "select * from Line_Info where cardno='" & Trim(txtCID.Text) & "' and ondate='" & Trim(txtOnDate.Text) & "' and ontime='" & Trim(txtOnTime.Text) & "'"
                            Set mrcline = ExecuteSQL(lineSQL, lineMsgText)
                            '判断是否存在上机记录
                            If mrcline.EOF Then
                                MsgBox "该用户没有上机记录，请仔细确认！", vbOKCancel + vbQuestion, "提示"
                                txtBalance.Text = ""
                                txtCID.Text = ""
                                txtSID.Text = ""
                                txtSex.Text = ""
                                txtType.Text = ""
                                txtStudentName.Text = ""
                                txtDepartment.Text = ""
                                txtOnDate.Text = ""
                                txtOnTime.Text = ""
                                txtOffDate.Text = ""
                                txtOffTime.Text = ""
                                txtCMoney.Text = ""
                                txtCTime.Text = ""
                                mrcline.Close
                                Exit Sub
                            Else
                                '更新数据表line_info
                                mrcline.Fields(8) = Date
                                mrcline.Fields(9) = Time
                                mrcline.Fields(10) = ADDTime
                                mrcline.Fields(11) = Trim(txtCMoney.Text)
                                mrcline.Fields(12) = Trim(txtBalance.Text)
                                mrcline.Fields(13) = "正常下机"
                                mrcline.Update
                                mrcline.Close
                                mrconline.Delete
                            End If
                            mrcstudent.Close
                            mrconline.Close
                            mrcbasic.Close
                        End If
                    End If
                End If
            End If
        End If
        MsgBox "此卡已成功下机！", vbOKOnly + vbExclamation, "提示"
        txtCID.SetFocus
    End If
End Sub

退出系统的操作：

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    '对worklog_info表操作
    Dim mrcworklog As ADODB.Recordset '用于存放记录集
    Dim worklogSQL As String '用于存放SQL语句
    Dim worklogMsgText As String '用于存放返回信息
    
    Dim a As Integer
    
    '对onwork_info表操作
    Dim mrconwork As ADODB.Recordset '用于存放记录集
    Dim onworkSQL As String '用于存放SQL语句
    Dim onworkMsgText As String '用于存放返回信息
    
    onworkSQL = "select * from onwork_info where UserID='" & Trim(frmLogin.txtUserName.Text) & "'"
    Set mrconwork = ExecuteSQL(onworkSQL, onworkMsgText)
    
    worklogSQL = "select * from worklog_info where UserID='" & Trim(frmLogin.txtUserName.Text) & "' and status='True'"
    Set mrcworklog = ExecuteSQL(worklogSQL, worklogMsgText)
    
    '根据按钮不同执行不同的任务
    a = MsgBox("确定退出系统？", vbOKCancel + vbQuestion, "询问")
    If a = vbOK Then
        mrcworklog.Fields(5) = Date
        mrcworklog.Fields(6) = Time
        mrcworklog.Fields(8) = "False"
        mrcworklog.Update
        mrcworklog.Close
        mrconwork.Delete
        mrconwork.Close
        Unload frmLogin
        Cancel = 0
    Else
        Cancel = 1
    End If

优化方面：

1.禁止粘贴
除卡号外所有控件禁止粘贴

Private Sub txtCMoney_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    '不可粘贴
    If Button = 2 Then
        Clipboard.Clear
    End If
End Sub

2.实时显示时间

Private Sub Timer1_Timer()
    lblTime.Caption = Format(Now, "hh:mm:ss")
End Sub

3.实时更新上机人数
上下机代码中也存在

Private Sub MDIForm_Load()
    '对online_info表操作
    Dim mrconline As ADODB.Recordset '用于存放记录集
    Dim onlineSQL As String '用于存放SQL语句
    Dim onlineMsgText As String '用于存放返回信息

    '显示上机人数
    
    onlineSQL = "select * from OnLine_info"
    Set mrconline = ExecuteSQL(onlineSQL, onlineMsgText)
    
    If mrconline.EOF Then
        lblNOWPeople.Caption = 0
    Else
        lblNOWPeople.Caption = mrconline.RecordCount '计算上机总人数
    End If
End Sub

4.限制字符类型
见下面博客：
https://blog.csdn.net/TGB__15__ZYB/article/details/86636625
5.动态查询，强制下机

Private Sub Timer2_Timer()
    Dim i As Integer '用于计算数组号
    Dim datevalue As Integer '用于日期的差值
    Dim timevalue As Integer '用于时间的差值
    Dim sumTime As Integer '用于计算上机时间
    Dim cardno As String '用于承载卡号
    Dim pay As Long '用于计算单价
    Dim Consume As Long '用于总花费金额
    '对Online_info表的操作
    Dim mrconline As ADODB.Recordset '用于存放记录集
    Dim onlineSQL As String '用于存放SQL语句
    Dim onlineMsgText As String '用于存放返回信息
    '对student_info表操作
    Dim mrcstudent As ADODB.Recordset '用于存放记录集
    Dim studentSQL As String '用于存放SQL语句
    Dim studentMsgText As String '用于存放返回信息
    '对basic_info表操作
    Dim mrcbasic As ADODB.Recordset '用于存放记录集
    Dim basicSQL As String '用于存放SQL语句
    Dim basicMsgText As String '用于存放返回信息
    '对Line_info表操作
    Dim mrcline As ADODB.Recordset '用于存放记录集
    Dim lineSQL As String '用于存放SQL语句
    Dim lineMsgText As String '用于存放返回信息
    
    onlineSQL = "select * from OnLine_Info "
    Set mrconline = ExecuteSQL(onlineSQL, onlineMsgText)
    
    If mrconline.EOF = False Then
        mrconline.MoveFirst
    Else
        Timer2.Enabled = False
        Exit Sub
    End If
    '定义一个未知长度的数组
    ReDim a(mrconline.RecordCount) As String
    '动态的查询余额情况，一旦不足就下机
    For i = 0 To mrconline.RecordCount - 1
        a(i) = Trim(mrconline.Fields(0))
        cardno = a(i)
        
        studentSQL = "select * from student_info where cardno='" & Trim(cardno) & "'"
        Set mrcstudent = ExecuteSQL(studentSQL, studentMsgText)
        
        lineSQL = "select * from Line_Info where cardno='" & Trim(cardno) & "' and ondate='" & Trim(mrconline.Fields(6)) & "' and ontime='" & Trim(mrconline.Fields(7)) & "'"
        Set mrcline = ExecuteSQL(lineSQL, lineMsgText)
        
        basicSQL = "select * from basicdata_info "
        Set mrcbasic = ExecuteSQL(basicSQL, basicMsgText)
        
        datevalue = DateDiff("n", Trim(mrconline(6)), Date)
        timevalue = DateDiff("n", Trim(mrconline(7)), Time)
        'abs()函数时绝对值函数；datediff（"单位",日期1,日期2）计算时间差
        sumTime = Abs(datevalue + timevalue)
        
        '用户不同，收费不同
        If Trim(mrconline.Fields(1)) = "固定用户" Then
            'round（）四舍五入保留两位小数；
            pay = Round(mrcbasic.Fields(0) / 60)
        Else
            pay = Round(mrcbasic.Fields(1) / 60)
        End If
        If sumTime < Val(mrcbasic.Fields(4)) Then
            Consume = 0
        Else
            If sumTime < Val(mrcbasic.Fields(3)) Then
                Consume = 1
            Else
                Consume = pay * sumTime
            End If
        End If
        
        '更新Student表
        mrcstudent.Fields(7) = mrcstudent.Fields(7) - Consume
        mrcstudent.Update
        
        If Val(mrcstudent.Fields(7)) > 0 And Val(mrcstudent.Fields(7)) <= Val(mrcbasic.Fields(5)) Then
            MsgBox a(i) & "您卡内余额已不足" & Val(mrcbasic.Fields(5)) & "元，请及时充值！", vbOKOnly + vbInformation, "提示"
        End If
        
        '判断余额是否小于零
        If Val(mrcstudent.Fields(7)) <= 0 Then
            mrcstudent.Fields(7) = 0
            mrcstudent.Update
            mrconline.Delete
            mrconline.Update
            MsgBox "卡号：" & a(i) & "余额不足，即将下机！", vbOKOnly + vbInformation, "提示"
        End If
        
        '更新line表
        mrcline.Fields(8) = Date
        mrcline.Fields(9) = Time
        mrcline.Fields(10) = sumTime
        mrcline.Fields(11) = Consume
        mrcline.Fields(12) = Trim(mrcstudent.Fields(7))
        mrconline.MoveNext
    Next i
    mrcstudent.Close
    mrcbasic.Close
    mrconline.Close
End Sub

6.限制除卡号外的文本框禁止输入

Private Sub txtBalance_KeyPress(KeyAscii As Integer)
    KeyAscii = 0 '不可输入值
End Sub

7.对于其他界面单次只能显示一个界面

Private Sub Balance_Click()
    frmBalance.Show
    Unload frmAbout
    Unload frmADDUser
    Unload frmADUser
    Unload frmCancelCard
    Unload frmCollectionCharge
    Unload frmControlRecord
    Unload frmDailyBill
    Unload frmDutyTeacher
    Unload frmExplain
    Unload frmInquery
    Unload frmInqueryONRecord
    Unload frmInqueryReChargeRecord
    Unload frmInqueryStatus
    Unload frmModifyData
    Unload frmModifyPassword
    Unload frmModifyStudentInformation
    Unload frmReCharge
    Unload frmRegister
    Unload frmReturnCharge
    Unload frmSettleAccount
    Unload frmStudentInformation
    Unload frmWeeklyBill
    Unload frmWriter
End Sub

追寻_无憾

关注

0
点赞
踩
0

收藏

觉得还不错? 一键收藏
7
评论
第一次机房收费系统之上下机界面

上下机界面流程如下：上机：输入卡号-----判断是否输入（否提示请输入卡号）-----连接student_info、online_info和line_info表-----进行数据比对-----满足条件的上机下机：输入卡号-----判断是否输入（否提示请输入卡号）-----连接student_info、online_info和line_info表-----进行数据比对-----满足条件下机...
复制链接

扫一扫