敲机房的时候感觉有一些的问题需要改进所以就相应的做了一些的更改
1、当卡号中余额为0的时候自动下机
Dim mrc As ADODB.Recordset '选择在线online表
Dim txtSQl, MsgText As String
Dim mr As ADODB.Recordset '选择学生表提取金额
Dim m As ADODB.Recordset '选择基本数据表用于固定用户和临时用户开销
Dim mrr As ADODB.Recordset
txtSQl = "select * from online_info"
Set mrc = ExecuteSQL(txtSQl, MsgText)
txtSQl = "select * from BasicData_Info"
Set m = ExecuteSQL(txtSQl, MsgText)
Do While Not mrc.EOF
txtSQl = "select * from student_Info where cardno='" & Trim(mrc.Fields(0)) & "'"
Set mr = ExecuteSQL(txtSQl, MsgText)
mrc.Fields(10) = Trim(mrc.Fields(10)) + 1
mrc.Update
If Trim(mr.Fields(14)) = "固定用户" Then
txtTime.Text = mr.Fields(7) / m.Fields(1) * 60 - mrc.Fields(10)
alltime.Text = mr.Fields(7) / m.Fields(1) * 60
Else
txtTime.Text = mr.Fields(7) / m.Fields(0) * 60 - mrc.Fields(10)
alltime.Text = mr.Fields(7) / m.Fields(0) * 60
End If
txtadd.Text = DateDiff("n", mrc.Fields(6), Format(Now, "yyyy-mm-dd")) '计算相差分钟数
txtadd.Text = txtadd.Text + DateDiff("n", Trim(mrc.Fields(7)), Format(Now, "hh:mm:ss"))
If Int(txtadd.Text) > Int(alltime) Then
MsgBox ("卡号" & mrc.Fields(0) & "已经没有费了"), vbOKOnly + vbExclamation, "提示"
mr.Fields(7) = 0
mr.Fields(6) = "不使用"
mr.Update
End If
If txtTime.Text < 10 And txtTime.Text > 8 Then
MsgBox ("卡号" & Trim(mrc.Fields(0)) & "余额不足，十分钟后将自动下机，请尽快提示充值")
End If
If txtTime.Text = 1 Then
MsgBox ("卡号" & Trim(mrc.Fields(0)) & "即将在1分钟后自动下机")
End If
If txtTime.Text = 0 Then
MsgBox ("卡号" & Trim(mrc.Fields(0)) & "余额为0，欢迎下次再来")
mr.Fields(10) = "不使用"
mr.Update
End If
If Trim(mr.Fields(6)) = "不使用" Then
txtSQl = "delete from online_info where cardno='" & mr.Fields(10) & "'"
Set mrr = ExecuteSQL(txtSQl, MsgText)
End If
mrc.MoveNext
Loop
首先就是卡号是否为空、卡号要是数字、卡号是否还在使用、此卡是否正在上机
再次计时计算时间，根据消费的时间算出相应的花销
最后就是更新Line_info 中的数据库 删除Online_info中下机的卡号的信息
<span style="font-size:18px;">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, b, c As String
'判断下机卡号是否为空
If txtCardID.Text = "" Then '判断卡号是否为空
MsgBox "请输入卡号！", 0 + 48, "提示"
Exit Sub
txtCardID.SetFocus
txtCardID.Text = ""
End If
'判断下机卡号是否是数字
If Not IsNumeric(txtCardID.Text) Then '判断卡号是否为数字
MsgBox "卡号请输入数字！", 0 + 48, "提示"
txtCardID.SetFocus
txtCardID.Text = ""
Exit Sub
End If
'判断卡号是否还在使用
txtSQl = "select * from student_Info where cardno ='" & Trim(txtCardID.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(txtCardID.Text) & "'"
Set mrce = ExecuteSQL(txtSQl, MsgText)
If mrce.EOF Then
MsgBox "此卡号没有上机，请重新选择！", vbOKOnly + vbExclamation, "警告"
txtID.Text = ""
txtDepartment.Text = ""
txtType.Text = ""
txtName.Text = ""
txtSex.Text = ""
txtOndate.Text = ""
txtOntime.Text = ""
txtCash.Text = ""
txtOffdate.Text = ""
txtOfftime.Text = ""
txtCosttime.Text = ""
txtCost.Text = ""
txtCardID.Text = ""
Exit Sub
Else
'此卡正在上机
txtID.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
Label4.Caption = mrce.RecordCount
End If
txtOffdate.Text = Format(Date, "yyyy-mm-dd")
txtOfftime.Text = Format(time, "hh:mm")
b = Abs(DateDiff("n", txtOfftime, c)) '计算上机时间
txtCosttime.Text = b
'计算上机时间
txtSQl = "select * from BasicData_Info"
Set mrc = ExecuteSQL(txtSQl, MsgText)
'第一种情况:上机时间<准备时间
If Val(txtCosttime.Text) < Val(mrc.Fields(4)) Then '上机时间小于准备时间
txtCost.Text = 0
txtCosttime.Text = 0
'第二种情况:准备时间<上机时间<最下上机时间
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
'第二种情况:上机时间>最小上机时间
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
txtSQl = "select * from Line_Info " '‘where '正常上机' and cardno ='" & Trim(txtCardID.Text) & "'"
Set mrcc = ExecuteSQL(txtSQl, MsgText)
mrcc.AddNew
mrcc.Fields(1) = Trim(txtCardID.Text)
mrcc.Fields(2) = Trim(txtID.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(14) = Trim(VBA.Environ("computername")) '获取计算机名
mrcc.Fields(11) = Trim(txtCost.Text)
mrcc.Fields(12) = Trim(txtCash.Text)
mrcc.Fields(8) = Trim(txtOffdate.Text)
mrcc.Fields(9) = Trim(txtOfftime.Text)
mrcc.Fields(10) = Trim(txtCosttime.Text)
mrcc.Fields(13) = Trim("正常下机")
mrcc.Update</span>
3、关于报表
'日结账单刷新
Dim txtSQl As String
Dim mrc As ADODB.Recordset
Dim MsgText As String
GRDisplayViewer1.Stop
txtSQl = "select * from CheckDay_info"
'创建报表对象
Set Report = New grproLibCtl.GridppReport
'载入报表模版文件
Report.LoadFromFile (App.Path & "\daycheck.grf")
'设置数据连接串
Report.DetailGrid.Recordset.ConnectionString = ConnectString
Report.DetailGrid.Recordset.QuerySQL = txtSQl
'显示报表中的内容
' GRDisplayViewer1.Refresh '刷新
GRDisplayViewer1.Report = Report
GRDisplayViewer1.Start
' 给报表赋值
Report.ParameterByName("EndDate").Value = Format(Now, "yyyy-mm-dd")
Report.ParameterByName("XX").Value = Trim(Username)
Report.ParameterByName("OPT").Value = Trim(Username)
最后机房已经完成的差不多了，就更新到这里吧！机房给我的教训就是以后再做一个系统之前一定要先理清思路。
扫一扫
4364
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
