机房收费系统——下机

流程图

代码展示

-下机结算

'下机结算：时间,金额(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.套路
先把逻辑弄清楚，再写代码，再解决问题，再优化体验。这是适用于我的套路，每每跳着完成，我都会方寸大乱。

以此自省！