流程图
部分代码
Private Sub cmdOffLine_Click()
Dim mrcBa As ADODB.Recordset
Dim mrcStu As ADODB.Recordset
Dim mrcOn As ADODB.Recordset
Dim mrcline As ADODB.Recordset
Dim MsgText As String
Dim txtSQL As String
Dim time1 As Integer ' 临时时间变量
Dim rate As Single '固定用户单位时间费用
Dim tmprate As Single '临时用户单位时间费用
Dim cash As Single '临时金额变量
Dim unittime As Single
'判断是否有卡号
If (txtcardNo = "") Then
MsgBox "未有卡号上机!", vbOKOnly + vbExclamation, "提示"
txtcardNo.SetFocus
Exit Sub
End If
'判断卡号是否存在
txtSQL = "select * from student_Info where cardno = '" & txtcardNo.Text & "'"
Set mrcStu = ExecuteSQL(txtSQL, MsgText)
If mrcStu.EOF Then
MsgBox "此卡号未注册!", vbOKOnly + vbExclamation, "提示"
txtcardNo.Text = ""
txtcardNo.SetFocus
mrcStu.Close
Exit Sub
Else
If mrcStu.Fields(10) = "不使用" Then
MsgBox "此卡号已经退卡!", vbOKOnly + vbExclamation, "提示"
txtcardNo.Text = ""
txtcardNo.SetFocus
Exit Sub
End If
'判断此卡是否上机
txtSQL = "select * from OnLine_Info where cardno='" & txtcardNo.Text & "'"
Set mrcOn = ExecuteSQL(txtSQL, MsgText)
txtSQL = "select * from student_Info where cardno = '" & txtcardNo.Text & "'"
Set mrcStu = ExecuteSQL(txtSQL, MsgText)
If mrcOn.EOF Then
MsgBox "此卡号已经下机!", vbOKOnly + vbExclamation, "提示"
txtcardNo.Text = ""
txtType.Text = ""
txtStudentNO.Text = ""
txtName.Text = ""
txtDept.Text = ""
txtSex.Text = ""
txtOnDate.Text = ""
txtOnTime.Text = ""
txtOffDate.Text = ""
txtOffTime.Text = ""
txtBalance.Text = ""
txtCTime.Text = ""
txtCMoney.Text = ""
Exit Sub
Else
txtType.Text = mrcOn.Fields(1)
txtStudentNO.Text = mrcOn.Fields(2)
txtName.Text = mrcOn.Fields(3)
txtDept.Text = mrcOn.Fields(4)
txtSex.Text = mrcOn.Fields(5)
txtOnDate.Text = mrcOn.Fields(6)
txtOnTime.Text = mrcOn.Fields(7)
txtOffDate.Text = Date
txtOffTime.Text = Time
mrcOn.Update
mrcOn.Close
'计算消费时间
txtBalance.Text = Trim(mrcStu.Fields(7))
txtdate = DateDiff("n", txtOnDate.Text, Date) 'datediff函数
txttime = DateDiff("n", txtOnTime.Text, Time)
txtCTime.Text = Int(txttime) + Int(txtdate)
'查询表获取基本信息
txtSQL = "select * from BasicData_Info "
Set mrcBa = ExecuteSQL(txtSQL, MsgText)
unittime = Val(mrcBa.Fields(2))
rate = Trim(mrcBa.Fields(0))
'准备时间
If Val((txtCTime.Text)) < mrcBa.Fields(4) Then
txtCTime.Text = 0
txtCMoney.Text = 0
MsgBox "在规定的时间内免费试用!", vbOKCancel + vbExclamation, "提示"
Exit Sub
End If
'判断时间
If (Val(txtCTime.Text) - Val(mrcBa.Fields(4))) < mrcBa.Fields(3) Then '上机时间小于准备时间,则消费时间为0
time1 = 0
txtCTime.Text = Val(time1) '更新消费时间
txtCMoney.Text = 0
Else
time1 = Val(txtCTime.Text) - Val(mrcBa.Fields(3)) - Val(mrcBa.Fields(4)) '否则则是上机时间减去
txtCTime.Text = Val(time1) '更新消费时间
Select Case Trim(txtType.Text) '判断用户,计算消费的金额
Case "固定用户"
cash = Round(Val(txtCTime.Text) / unittime * rate, 2)
'处理消费金额小于1的时候0不显示的问题
If cash > 1# Then
txtCMoney.Text = Str(cash)
Else
txtCMoney.Text = "0" & Str(cash)
End If
mrcStu.Fields(7) = Val(txtBalance.Text) - cash
txtBalance.Text = mrcStu.Fields(7)
mrcStu.Update
Case "临时用户"
cash = Round(Val(txtCTime.Text) / unittime * tmprate, 2) '计算临时用户消耗的时间
'处理消费金额小于1的时候0不显示的问题
If cash > 1# Then
txtCMoney.Text = Trim(Str(cash))
Else
txtCMoney.Text = Trim("0" & Str(cash))
End If
mrcStu.Fields(7) = Val(txtBalance.Text) - cash '计算余额
txtBalance.Text = mrcStu.Fields(7)
mrcStu.Update
End Select
'更新line表
txtSQL = "update Line_Info set offdate=Trim(txtOffDate.Text) ,offtime=Trim(txtOffTime.Text),consumTime= Trim(txtCTime.Text) where ondate='" & Trim(txtOnDate.Text) & "' and ontime='" & Trim(txtOnTime.Text) & "'"
Set mrcline = ExecuteSQL(txtSQL, MsgText)
'删除上机信息
txtSQL = "delete from online_info where cardno= '" & txtcardNo.Text & "'"
Set mrcOn = ExecuteSQL(txtSQL, MsgText)
mrcStu.Close
End If
'计算下机人数
lblPeople.Caption = Str(Int(lblPeople.Caption - 1))
MsgBox "下机成功,欢迎下次再来!", vbOKOnly + vbInformation, "提示"
End If
End If
Label12.Visible = False
End Sub
ps: 很好的使用SQL语句可以减少代码量,更好的提高你的效率
总结
下机相对于上机来说真的要麻烦很多,但是却让我学会了更多,尤其是计算费用的那个地方,一定要认真处理,不然很有可能就计算错了,那样管理者会亏得很惨,数据库中的数据一定要记得更新,花费的费用也一定要记得计算,这样管理者就正常了,那么消费者也不能亏,所以下机的时候一定要记得更新Online表。做好这些,还需要掌握好逻辑哟,加油!!