开篇:
下机这一过程在机房中具体体现为3处,一处是主窗体上的下机;还有就是选中学生下线和所有学生下线了,这可以说是一个难点,但是别急,我这个小鸟也可以带你们飞啊,如果方向错了,欢迎提醒哈!
逻辑过程:
一、下机
1.必要的判断不可少
卡号是否为空,是否输入数字,是否还在使用(student_Info),是否正在上机(Online_Info)。由于这些判断经常用,这里不再进行代码展示。
2.查询下机需要填写的内容
下机日期和时间,这个很简单,直接是Date,Time即可。
之后是消费时间的计算:
labConsumetime.Caption = (Date - DateValue(mrconline!ondate)) * 1440 + (Hour(Time) - Hour(TimeValue(mrconline!OnTime))) * 60 + (Minute(Time) - Minute(TimeValue(mrconline!OnTime))) '单位时间为分钟 '计算消费时间
很长的代码,但是很好理解,就是下机时间和上机时间中间走过的分钟数。
然后是消费金额的计算,这是一个重点:首先从BasicData_Info表中获取基础数据;然后根据消费时间来判断应该收取多少钱,中间有准备上机时间和最少上机时间,如果没有超过两者之和,都是不收取费用的!超过两者之和的话,应判断是临时用户还是固定用户,不同类型的用户其费率不一样;最后,下机成功,删除Online_Info表里的相应记录,并在当前上机人数地方-1。
Dim w1 As Currency '固定用户费率
Dim w2 As Currency '临时用户费率
Dim money As Double '消费金额
Dim a1 As Long '最少上机时间
Dim a2 As Long '准备上机时间
Dim x As Long '单位递增时间
Dim w As Currency '最少金额
'连接BasicData表
txtSQL = "select *from BasicData_Info"
Set mrcbas = ExecuteSQL(txtSQL, Msgtext)
'为各变量赋值
With mrcbas
w1 = Trim(.Fields(0))
w2 = Trim(.Fields(1))
x = Trim(.Fields(2))
a1 = Trim(.Fields(3))
a2 = Trim(.Fields(4))
w = Trim(.Fields(5))
End With
'计算消费时间和金额
'固定用户一小时费用为 w1,临时用户一小时费用为w2,至少上机时间为t1,准备时间为t2,最少金额为w,
'上机时间为time1,下机时间为time2,输出的钱为money,x为递增单位时间
'准备时间不收钱,没有达到最少上机时间,收取金额为最少金额,达到最少上机时间后,按时间计算
'没有达到准备上机时间
If Val(labConsumetime.Caption) < a2 Then
MsgBox "没有达到上机准备时间,不收取费用!", 48, "提示"
'删除上机信息
txtSQL = "delete from online_info where cardno= '" & txtCardno.Text & "'"
Set mrconline = ExecuteSQL(txtSQL, Msgtext)
money = 0
labConsume.Caption = Val(money)
'查询学生表中的信息
txtSQL = "select * from student_info"
Set mrcstu = ExecuteSQL(txtSQL, Msgtext)
mrcstu.Fields(7) = Val(labCash.Caption) - Val(money)
labCash.Caption = mrcstu.Fields(7)
mrcstu.Update
mrcstu.Close
labCount.Caption = Str(Int(labCount.Caption - 1))
End If
'没有达到最少上机时间
If Val(labConsumetime.Caption) > a1 + a2 Then
If Val(labConsumetime.Caption) <= a1 + a2 Then
MsgBox "未达到最少上机时间,给亲优惠不收费哦!", vbOKOnly + vbInformation, "提示"
money = 0
labConsume.Caption = Val(money)
'删除上机信息
txtSQL = "delete from online_info where cardno= '" & txtCardno.Text & "'"
Set mrconline = ExecuteSQL(txtSQL, Msgtext)
txtSQL = "select * from student_info"
Set mrcstu = ExecuteSQL(txtSQL, Msgtext)
mrcstu.Fields(7) = Val(labCash.Caption) - Val(money)
labCash.Caption = mrcstu.Fields(7)
mrcstu.Update
mrcstu.Close
labCount.Caption = Str(Int(labCount.Caption - 1))
End If
'达到最少上机时间了
'这里又分为固定用户和临时用户
If Val(labConsumetime.Caption) > a1 + a2 Then
Select Case Trim(labCardtype.Caption)
Case "固定用户"
txtSQL = "select * from student_info where cardno= '" & txtCardno.Text & " 'and status= '使用'"
Set mrcstu = ExecuteSQL(txtSQL, Msgtext)
money = Round(Val(labConsumetime.Caption) / x * w1, 2)
If money > 1# Then '处理消费金额小于1的时候0不显示的问题
labConsume.Caption = Str(money)
Else
labConsume.Caption = "0" & Str(money)
End If
mrcstu.Fields(7) = labCash.Caption - money
labCash.Caption = mrcstu.Fields(7)
mrcstu.Update
mrcstu.Close
'删除上机信息
txtSQL = "delete from online_info where cardno= '" & txtCardno.Text & "'"
Set mrconline = ExecuteSQL(txtSQL, Msgtext)
txtSQL = "select * from student_info"
Set mrcstu = ExecuteSQL(txtSQL, Msgtext)
Case "临时用户"
txtSQL = "select * from student_info where cardno= '" & txtCardno.Text & " 'and status= '使用'"
Set mrcstu = ExecuteSQL(txtSQL, Msgtext)
money = Round(Val(labConsumetime.Caption) / x * w2, 2)
If money > 1# Then '处理消费金额小于1的时候0不显示的问题
labConsume.Caption = Str(money)
Else
labConsume.Caption = "0" & Str(money)
End If
mrcstu.Fields(7) = labCash.Caption - money
labCash.Caption = mrcstu.Fields(7)
mrcstu.Update
mrcstu.Close
'删除上机信息
txtSQL = "delete from online_info where cardno= '" & txtCardno.Text & "'"
Set mrconline = ExecuteSQL(txtSQL, Msgtext)
txtSQL = "select * from student_info"
Set mrcstu = ExecuteSQL(txtSQL, Msgtext)
End Select
MsgBox "下机成功,欢迎下次再来!", vbOKOnly + vbInformation, "提示"
labCount.Caption = Str(Int(labCount.Caption - 1))
End If
End If
End If
这样下机就可以完成了。
3.主窗体上有一个“当前上机人数为”,这个很简单。
只需查询Online_Info表,显示表中有几条记录即可。
txtSQL = "select * from OnLine_Info"
Set mrconline = ExecuteSQL(txtSQL, Msgtext)
labCount.Caption = mrconline.RecordCount
二、所有学生下线
Dim mrc As ADODB.Recordset
Dim Msgtext As String
Dim txtSQL As String
Dim i As Integer
Dim m As Integer
txtSQL = "select * from OnLine_Info "
Set mrc = ExecuteSQL(txtSQL, Msgtext)
If mrc.EOF = True Then
MsgBox "没有学生上机!", vbOKOnly + vbExclamation, "提示"
Else
Do While Not mrc.EOF
i = mrc.Fields(0)
frmMain.Show
frmMain.txtCardno = i '将卡号赋给frmMain窗体中的卡号文本框
frmMain.cmdOutline = True '执行下机操作
mrc.MoveNext
Loop
MSHFlexGrid1.Rows = 1 '删除MSFlexGrid中的数据
MsgBox "所有学生成功下机!", vbOKOnly + vbExclamation, "提示"
frmMain.labCount = "0"
End If
三、选中学生下线
Dim mrc As Recordset
Dim Msgtext As String
Dim txtSQL As String
Dim i As Integer
If Val(MSHFlexGrid1.RowSel) = 0 Then
MsgBox "请选择学生下线!", vbOKOnly + vbExclamation, "提示"
Exit Sub
End If
If MSHFlexGrid1.RowSel = MSHFlexGrid1.Row = 0 Then
MsgBox "首行不能删除!", vbOKOnly + vbExclamation, "提示"
Exit Sub
End If
txtSQL = "select * from student_Info where cardno= '" & Trim(MSHFlexGrid1.TextMatrix(MSHFlexGrid1.RowSel, 0)) & "'"
Set mrc = ExecuteSQL(txtSQL, Msgtext)
i = mrc.Fields(0) '卡号
frmMain.Show
frmMain.txtCardno = i '将卡号赋给frmMain窗体中的卡号文本框
frmMain.cmdOutline = True '执行下机操作
MSHFlexGrid1.RemoveItem MSHFlexGrid1.RowSel '删除Msflexgrid表中选中的一行
选中学生下线和所有学生下线,这两个都用到了下机的代码,把选中的卡号赋给主窗体的卡号框,激发主窗体上的下机操作,走下机的代码,这样就可以省很多的代码了!
小结:
这是关乎下机的一系列过程,最重要的是可以把钱理清楚,计算消费金额的那一块,当时我也是一篇混乱,现在看来还可以哦!