现在梳理一下MDI窗体上的上下机步骤：
上机流程图：
上机代码：
上机代码没有难度，就要锻炼自己的一个逻辑思维，还要把握全局观。
Private Sub cmdoncom_Click() '设置上机键 Dim mrc As ADODB.Recordset Dim mrcc As ADODB.Recordset Dim mrcd As ADODB.Recordset Dim mrce As ADODB.Recordset Dim mrcb As ADODB.Recordset Dim txtSQL As String Dim MsgText As String Timer2.Enabled = True '判断是否正在上机 txtSQL = "select * from OnLine_Info where cardno ='" & Trim(txtcardno.Text) & "'" '判断是否正在上机 Set mrcd = ExecuteSQL(txtSQL, MsgText) If Not mrcd.EOF Then MsgBox "此卡正在上机！", 0 + 48, "提示" Exit Sub End If mrcd.Close '判断是否输入卡号 If txtcardno.Text = "" Then '判断卡号是否为空 MsgBox "请输入卡号！", 0 + 48, "提示" Exit Sub End If '判断卡号是否是数字 If Not IsNumeric(Trim(txtcardno.Text)) Then '卡号得为数字 MsgBox "请输入数字！", vbOKOnly + vbExclamation, "警告" Exit Sub End If '判断卡号是否是活跃卡 txtSQL = "select * from student_Info where cardno ='" & Trim(txtcardno.Text) & "'" Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF Then MsgBox "卡号不存在或者已经不用了", 0 + 48, "提示" '判断卡号是否被使用 Exit Sub mrc.Close End If '判断卡的余额是否够 If mrc.Fields(7) <= 0 Then MsgBox "亲，余额不足，请充值！", 0 + 48, "提示" '判断余额是否还有 Exit Sub mrc.Close Else txtstudentNo.Text = mrc.Fields(1) txtDepartment.Text = mrc.Fields(4) txttype.Text = mrc.Fields(14) txtName.Text = mrc.Fields(2) txtSex.Text = mrc.Fields(3) txtondate.Text = Format(Date, "yyyy-mm-dd") txtontime.Text = Format(Time, "hh:mm") txtcash.Text = mrc.Fields(7) txtoffdate.Text = "" txtofftime.Text = "" txtcosttime.Text = "" txtcost.Text = "" mrc.Close End If '更新上机记录表中的数据 txtSQL = "select * from Line_Info" Set mrcc = ExecuteSQL(txtSQL, MsgText) mrcc.AddNew mrcc.Fields(1) = Trim(txtcardno.Text) mrcc.Fields(2) = Trim(txtstudentNo.Text) mrcc.Fields(3) = Trim(txtName.Text) mrcc.Fields(4) = Trim(txtDepartment.Text) mrcc.Fields(5) = Trim(txtSex.Text) mrcc.Fields(6) = txtondate.Text mrcc.Fields(7) = txtontime.Text mrcc.Fields(8) = Null mrcc.Fields(9) = Null mrcc.Fields(10) = Null mrcc.Fields(11) = Trim("0.0") mrcc.Fields(12) = Trim(txtcash.Text) mrcc.Fields(13) = Trim("正常上机") mrcc.Fields(14) = Trim(VBA.Environ("computername")) '获取计算机名 mrcc.Update '更新正在线的用户 txtSQL = "select * from OnLine_Info" Set mrce = ExecuteSQL(txtSQL, MsgText) mrce.AddNew mrce.Fields(0) = Trim(txtcardno.Text) mrce.Fields(1) = Trim(txttype.Text) mrce.Fields(2) = Trim(txtstudentNo.Text) mrce.Fields(3) = Trim(txtName.Text) mrce.Fields(4) = Trim(txtDepartment.Text) mrce.Fields(5) = Trim(txtSex.Text) mrce.Fields(6) = Trim(txtondate.Text) mrce.Fields(7) = Trim(txtontime.Text) mrce.Fields(8) = Trim(VBA.Environ("computername")) '获取计算机名 mrce.Fields(9) = Date mrce.Update mrce.Close mrcc.Close MsgBox "恭喜您，上机成功！", 0 + 48, "提示" onliner = onliner + 1 Label22.Caption = onliner End Sub
下机流程图：
下机代码：
在下机代码中，有一些地方是比较费脑子的：
①计算上机时间，用到了DateDiff函数
②计算上机费用，分三种情况进行计算，
第一种情况:上机时间<准备时间
花费为0；
第二种情况:准备时间<上机时间<最下上机时间
花费为1；
第二种情况:上机时间>最小上机时间
计算用时(S)=上机时间(T)-准备时间(A)
计算用时周期（UnitNumber）=计算用时（S）MOD 递增用时周期
判断用户类别确定每小时上机费用（D）
计算花销=计算用时周期（UnitNumber）* 每小时上机费用（D）
Private Sub cmdoffcom_Click() Dim mrc As ADODB.Recordset Dim mrcc As ADODB.Recordset Dim mrcd As ADODB.Recordset Dim mrce As ADODB.Recordset Dim txtSQL As String Dim MsgText As String Dim Usetime, UnitNumber, a '判断下机卡号是否为空 If txtcardno.Text = "" Then '判断卡号是否为空 MsgBox "请输入卡号！", 0 + 48, "提示" Exit Sub txtcardno.SetFocus txtcardno.Text = "" End If '判断下机卡号是否是数字 If Not IsNumeric(txtcardno.Text) Then '判断卡号是否为数字 MsgBox "卡号请输入数字！", 0 + 48, "提示" txtcardno.SetFocus txtcardno.Text = "" Exit Sub End If '判断卡号是否还在使用 txtSQL = "select * from student_Info where cardno ='" & Trim(txtcardno.Text) & "'" Set mrcd = ExecuteSQL(txtSQL, MsgText) If mrcd.EOF Then MsgBox "卡号不存在或者已经不用了", 0 + 48, "提示" '判断卡号是否被使用 Exit Sub End If '判断输入的卡号是否在上机 txtSQL = "select * from OnLine_Info where cardno = '" & Trim(txtcardno.Text) & "'" Set mrce = ExecuteSQL(txtSQL, MsgText) If mrce.EOF Then MsgBox "亲，此卡号没有上机，请重新选择！", vbOKOnly + vbExclamation, "警告" txtstudentNo.Text = "" txtDepartment.Text = "" txttype.Text = "" txtName.Text = "" txtSex.Text = "" txtondate.Text = "" txtontime.Text = "" txtcash.Text = "" txtoffdate.Text = "" txtofftime.Text = "" txtcosttime.Text = "" txtcost.Text = "" txtcardno.Text = "" Exit Sub Else txtstudentNo.Text = mrcd.Fields(1) txtDepartment.Text = mrcd.Fields(4) txttype.Text = mrcd.Fields(14) txtName.Text = mrcd.Fields(2) txtSex.Text = mrcd.Fields(3) txtondate.Text = mrce.Fields(6) txtontime.Text = mrce.Fields(7) c = mrce.Fields(7) txtontime.Text = c mrce.Delete End If '下机并更新上机记录中的数据 txtSQL = "select * from Line_Info where status ='正常上机' and cardno ='" & Trim(txtcardno.Text) & "'" Set mrcc = ExecuteSQL(txtSQL, MsgText) txtoffdate.Text = Format(Date, "yyyy-mm-dd") txtofftime.Text = Format(Time, "hh:mm") b = Abs(DateDiff("n", txtofftime, c)) '计算上机时间 txtcosttime.Text = b mrcc.Fields(8) = Trim(txtoffdate.Text) mrcc.Fields(9) = Trim(txtofftime.Text) mrcc.Fields(10) = Trim(txtcosttime.Text) mrcc.Fields(13) = Trim("正常下机") '计算上机时间 txtSQL = "select * from BasicData_Info " Set mrc = ExecuteSQL(txtSQL, MsgText) '第一种情况:上机时间<准备时间 If Val(txtcosttime.Text) < Val(mrc.Fields(4)) Then '上机时间小于准备时间 txtcost.Text = 0 onliner = onliner - 1 Label22.Caption = onliner mrcc.Fields(11) = Trim(txtcost.Text) mrcc.Fields(12) = Trim(txtcash.Text) mrcc.Update Exit Sub '第二种情况:准备时间<上机时间<最下上机时间 ElseIf Val(mrc.Fields(4)) <= Val(txtcosttime.Text) And Val(txtcosttime.Text) <= Val(mrc.Fields(3)) Then '准备时间<上机时间<最少上机时间 txtcost.Text = 1 txtcash.Text = Val(mrcd.Fields(7)) - 1 mrcd.Fields(7) = Trim(txtcash.Text) mrcd.Update mrcc.Fields(11) = Trim(txtcost.Text) mrcc.Fields(12) = Trim(txtcash.Text) mrcc.Update onliner = onliner - 1 Label22.Caption = onliner Exit Sub '第二种情况:上机时间>最小上机时间 ElseIf Val(txtcosttime.Text) > Val(mrc.Fields(3)) Then '上机时间>最小上机时间 Usetime = Val(txtcosttime.Text) - Val(mrc.Fields(4)) UnitNumber = Usetime Mod Val(mrc.Fields(2)) If UnitNumber = 0 Then '用时小于周期 UnitNumber = Int(Usetime / Val(mrc.Fields(2))) 'int是取整函数，取证原则是比括号中的数值小的最接近的整数，不进行四舍五入。 所以 比-2.9还小的整数是-3，同样分析知道，int(2.9)=2 Else '用时大于周期 如 90/60=1.5 int(1.5)=1 说以要+1 UnitNumber = Int(Usetime / Val(mrc.Fields(2))) + 1 End If End If '判断此时用户类别 If mrcd.Fields(14) = "固定用户 " Then a = Val(mrc.Fields(0)) Else a = Val(mrc.Fields(1)) End If '计算最后的花销 txtcost.Text = Format(UnitNumber * a, "0.0") '计算最后的花费 txtcash.Text = Val(mrcd.Fields(7)) - Val(txtcost.Text) mrcd.Fields(7) = Trim(txtcash.Text) mrcd.Update mrcc.Fields(11) = Trim(txtcost.Text) mrcc.Fields(12) = Trim(txtcash.Text) mrcc.Update onliner = onliner - 1 Label22.Caption = onliner End Sub
小结：经历了算账的过程，不仅是代码的锻炼，更是思维的锻炼。上下机是很值得反复推敲的，我的也有 很多的问题，还需要完善，也希望我的总结可以给你带来帮助。
441
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
