机房收费系统——下机

流程图

代码展示

-下机结算

'下机结算：时间,金额(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.套路

先把逻辑弄清楚，再写代码，再解决问题，再优化体验。这是适用于我的套路，每每跳着完成，我都会方寸大乱。

以此自省！