机房收费系统——下机

拼搏现实的明天。 2022-05-31 13:55 151阅读 0赞

# 流程图 #

![这里写图片描述][70]

# 代码展示 #

\-**下机结算**

'下机结算：时间,金额(n为分钟）；显示下机数据
    
    txtSQLS = "select * from student_Info where cardno='" & Trim(txtCardNo.Text) & "'"
    Set mrc1 = ExecuteSQL(txtSQLS, Msgtext)
    
    txtSQLB = "select * from BasicData_Info"
    Set mrc2 = ExecuteSQL(txtSQLB, Msgtext)
    
    txtdate = DateDiff("n", lblOnDate, lblOffDate)
    txttime = DateDiff("n", lblOnTime, lblOffTime)
    lblCTime.Text = Int(txtdate) + Int(txttime)     '显示消费时间
    intconsumetime = lblCTime.Text
    
    '判断消费时间<准备时间
    If intconsumetime < mrc2.Fields(4) Then          
         lblCMoney.Text = "0"                       '消费金额=0
         lblCash.Text = Trim(mrc1.Fields(7))        '余额=余额-消费金额
    
     Else   
    
          '判断消费时间小于最小上机时间时消费金额为1
           If intconsumetime < mrc2!leastTime And intconsumetime > mrc2.Fields(4) Then                   
               lblCMoney.Text = "1"                 '消费金额=1
               lblCash.Text = Trim(mrc1.Fields(7)) - Trim(lblCMoney.Text)
    
           Else
    
               '判断临时用户的消费金额
               If mrc.Fields(1) = "临时用户" Then
                   lblCMoney.Text = (Int(intconsumetime / 60) + 1) * Trim(mrc2.Fields(1))
                   lblCash.Text = Trim(mrc1.Fields(7)) - Trim(lblCMoney.Text)
    
               Else
    
                   '判断固定用户的消费金额
                    lblCMoney.Text = (Int(intconsumetime / 60) + 1) * Trim(mrc2.Fields(0))
                    lblCash.Text = Trim(mrc1.Fields(7)) - Trim(lblCMoney.Text)
    
               End If
           End If
     End If

\-**余额不足，请先充值**

If Val(lblCash.Text) < 0 Then
            MsgBox "余额不足，下机失败，请先充值!", vbonly + vbExclamation, "提示"
    
            '显示充值窗体
            frmOpRecharge.Show   
            SetParent frmOpRecharge.hWnd, Picture1.hWnd
    
            '将下机卡号赋值给充值窗体卡号
            frmOpRecharge.txtCardNo.Text = txtCardNo.Text
            Exit Sub
    Else
         MsgBox "下机成功，欢迎下次再来!", vbonly + vbExclamation, "提示"

\-**利用timer控件实时更新上机人数**

Private Sub Timer1_Timer()     '利用timer控件实时更新上机人数
    
        Dim txtSQL As String
        Dim Msgtext As String
        Dim mrc As ADODB.Recordset
    
        Label12.Caption = Format(Now, "hh:mm:ss")   '获取当前时间
    
        txtSQL = "select * from Online_Info "
        Set mrc = ExecuteSQL(txtSQL, Msgtext)
        Label16.Caption = mrc.RecordCount
        mrc.Close
    
    End Sub

\-**循环清空内容**

'循环清空内容
     Dim ctr1 As Control
         For Each ctr1 In Me.Controls
    
         If TypeOf ctr1 Is TextBox Then
            ctr1.Text = ""
         End If
    
         Next

# 完整代码展示 #

Private Sub cmdOffLine_Click()
    
        Dim txtSQLB As String
        Dim txtSQLS As String
        Dim txtSQLO As String
        Dim txtSQLL As String
        Dim Msgtext As String
        Dim mrc As ADODB.Recordset     'online 表
        Dim mrc1 As ADODB.Recordset     'student表
        Dim mrc2 As ADODB.Recordset    'BasicData 表
        Dim mrc3 As ADODB.Recordset
    
        Dim txtdate As String
        Dim txttime As String
        Dim intconsumetime As String  '消费时间
    
        '输入学号
    
        If txtCardNo.Text = "" Then
                MsgBox "请输入学号!", vbOKOnly + vbExclamation, "警告"
                Exit Sub
        Else
        '判断该用户是否上机
    
         txtSQLO = "select * from OnLine_Info where cardno='" & Trim(txtCardNo.Text) & "'"
            Set mrc = ExecuteSQL(txtSQLO, Msgtext)
    
            If mrc.EOF = True Then
                    MsgBox "该卡号未上机,请重新确认", vbOKOnly + vbExclamation, "警告"
                    txtCardNo.Text = ""
                    txtCardNo.SetFocus
                    Exit Sub
    
            Else
            '显示上机帐号数据
    
            txtCardNo.Text = mrc!cardno
            lbltype.Text = mrc!cardtype
            lblSID.Text = mrc!studentNo
            lblName.Text = mrc!studentName
            lblDept.Text = mrc!Department
            lblSex.Text = mrc!sex
            lblOnDate.Text = Format(Trim(mrc.Fields(6)), "yyyy-mm-dd")
            lblOnTime.Text = Format(Trim(mrc.Fields(7)), "hh:mm:ss")
            lblOffDate.Text = Format(Date, "yyyy-mm-dd")
            lblOffTime.Text = Format(Time, "hh:mm:ss")
    
    
            '下机结算：时间,金额(n为分钟）；显示下机数据
            '......见上
    
            End If
       End If
    
    
       '余额不足，下机失败，请先充值!
       '......见上
    
        Else
    
        MsgBox "下机成功，欢迎下次再来!", vbonly + vbExclamation, "提示"
    
    
        '更新上机记录
    
        mrc.Delete
        mrc.Update
        mrc.Close
    
        '更新历史上机记录
    
            txtSQLL = "select * from Line_Info where cardno='" & Trim(txtCardNo.Text) & "'"
            Set mrc3 = ExecuteSQL(txtSQLL, Msgtext)
    
                mrc3.AddNew
                mrc3.Fields(1) = Trim(txtCardNo.Text)
                mrc3.Fields(2) = Trim(lblSID.Text)
                mrc3.Fields(3) = Trim(lblName.Text)
                mrc3.Fields(4) = Trim(lblDept.Text)
                mrc3.Fields(5) = Trim(lblSex.Text)
                mrc3.Fields(6) = Trim(lblOnDate.Text)
                mrc3.Fields(7) = Trim(lblOnTime.Text)
                mrc3.Fields(8) = Trim(lblOffDate.Text)
                mrc3.Fields(9) = Trim(lblOffTime.Text)
                mrc3.Fields(10) = Trim(lblCTime.Text)
                mrc3.Fields(11) = Trim(lblCMoney.Text)
                mrc3.Fields(12) = Val(lblCash.Text) '把字符串型换成数值型
                mrc3.Fields(13) = "正常上机"
                mrc3.Fields(14) = VBA.Environ("computername")
                mrc3.Update
                mrc3.Close
    
    
           '更新学生表学生信息
    
                mrc1.Fields(7) = Trim(lblCash.Text)
                mrc1.Fields(9) = UserName
                mrc1.Fields(10) = "使用"
                mrc1.Fields(11) = "已结账"
                mrc1.Fields(12) = Date
                mrc1.Fields(13) = Time
                mrc1.Update
                mrc1.Close
    
        End If
    
         '循环清空内容
         '......见上
    
    End Sub

# 反思 #

1.敲代码不能停  
下机窗体做了很久了，总是做做停停，思路连接不上，感觉难的不行，其实做完之后无非这点代码，只要每天完成一点，问题都会解决。  
2.困难像弹簧  
困难像弹簧，你弱它就强。任何任务没有完成之前，切忌将困难放大化。没有多大的困难是我们克服不了的。  
3.套路  
先把逻辑弄清楚，再写代码，再解决问题，再优化体验。这是适用于我的套路，每每跳着完成，我都会方寸大乱。

以此自省！

[70]: /images/20220531/1596d13ec4424ba794c7a3b259eb63a8.png