敲上下机之前看了一些师哥师姐的博客,给我的感觉是上机不难下机难,首先要设计好主窗体
然后对上下机各画一个流程图
- 上机
- 下机
在计算固定用户和临时用户的金额时,可以用下面这段代码:
intLineTime = (Date - DateValue(rstOnline!ondate)) * 1440 + (Hour(Time) - Hour(TimeValue(rstOnline!OnTime))) * 60 + (Minute(Time) - Minute(TimeValue(rstOnline!OnTime)))
'把固定用户、临时用户30分钟的费用分别赋给费用
fixedRate = Val(rstBasicData.Fields(0)) '把固定用户的金额赋给变量
fixedRate1 = Val(rstBasicData.Fields(1)) '把临时用户的金额赋给变量
'判断实际在线时间是否小于准备时间,若小于则消费时间为0
If intLineTime <= Val(Trim(rstBasicData.Fields(4))) Then
Label17.Caption = 0
Else
'判断实际在线时间是否小于最低消费时间,若小于消费为0
If intLineTime <= Val(Trim(rstBasicData.Fields(3))) Then
Label17.Caption = 0
Else
'实际在线时间大于最低消费时间则按单位时间算,分固定用户和临时用户
If intLineTime >= Val(Trim(rstBasicData!leastTime)) And intLineTime < Val(Trim(rstBasicData!unitTime)) And Trim(rstStudent.Fields(14)) = "固定用户" Then
Label17.Caption = fixedRate
Else
If intLineTime >= Val(Trim(rstBasicData!leastTime)) And intLineTime < Val(Trim(rstBasicData!unitTime)) And Trim(rstStudent.Fields(14)) = "临时用户" Then
Label17.Caption = fixedRate1
Else '当实际在线时间大于单位时间,就按有几个单位时间算,分固定用户和临时用户
If intLineTime > Val(Trim(rstBasicData!leastTime)) And Trim(rstStudent.Fields(14)) = "固定用户" Then
Label17.Caption = Int(intLineTime / 60 + 1) * Int(fixedRate)
Else
If intLineTime >= Val(Trim(rstBasicData!leastTime)) And Trim(rstStudent.Fields(14)) = "临时用户" Then
Label17.Caption = Int(intLineTime / 60 + 1) * Int(fixedRate1)
End If
End If
End If
End If
End If
End If
**
- 上机代码:
**
Dim mrc As ADODB.Recordset
Dim mrc2 As ADODB.Recordset
Dim MsgText As String
Dim txtSQL As String
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
'Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
Text11.Text = ""
Text12.Text = ""
Text13.Text = ""
If Text1.Text = "" Then
MsgBox "请输入要上机的卡号!", vbOKOnly + vbExclamation, "警告"
Text1.SetFocus
Else
txtSQL = "select * from online_Info where cardno = '" & Trim(Text1.Text) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If mrc.EOF = False Then
MsgBox "此卡号正在上机!", vbOKOnly + vbExclamation, "警告"
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Combo1.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
Text11.Text = ""
Text12.Text = ""
Text13.Text = ""
Exit Sub
Else
txtSQL = "select * from student_Info where cardno = '" & "'and status = '" & "使用" & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If mrc.EOF = True Then
MsgBox "此卡号不存在", vbOKOnly + vbExclamation, "警告"
Text1.Text = ""
Exit Sub
Else
If Val(mrc.Fields(7)) < 1 Then
MsgBox "余额不足,请先充值!", vbOKOnly + vbExclamation, "警告"
Text1.Text = ""
Exit Sub
Else
Text2.Text = mrc.Fields(1)
Text3.Text = mrc.Fields(4)
Text4.Text = mrc.Fields(14)
Text5.Text = mrc.Fields(2)
Combo1.Text = mrc.Fields(3)
Text7.Text = Date
Text10.Text = Time
Text9.Text = Val(mrc.Fields(7))
txtSQL = "select * from online_Info" '增加状态为上机的表的数据
Set mrc = ExecuteSQL(txtSQL, MsgText)
mrc.AddNew
mrc.Fields(0) = Trim(Text1.Text)
mrc.Fields(1) = Trim(Text4.Text)
mrc.Fields(2) = Trim(Text2.Text)
mrc.Fields(3) = Trim(Text5.Text)
mrc.Fields(4) = Trim(Text3.Text)
mrc.Fields(5) = Trim(Combo1.Text)
mrc.Fields(6) = Trim(Text7.Text)
mrc.Fields(7) = Trim(Text10.Text)
mrc.Fields(8) = Trim("WEJ")
mrc.Fields(9) = Date
mrc.Update
lblOnlineNumber.Caption = mrc.RecordCount '在界面上显示正在上机的人数
mrc.Close
txtSQL = "select * from Line_Info"
Set mrc2 = ExecuteSQL(txtSQL, MsgText)
mrc2.AddNew
mrc2.Fields(1) = Trim(Text1.Text)
mrc2.Fields(2) = Trim(Text2.Text)
mrc2.Fields(3) = Trim(Text5.Text)
mrc2.Fields(4) = Trim(Text3.Text)
mrc2.Fields(5) = Trim(Combo1.Text)
mrc2.Fields(6) = Trim(Text7.Text)
mrc2.Fields(7) = Trim(Text10.Text)
mrc2.Fields(13) = "正常上机"
mrc2.Fields(14) = "WEJ"
mrc2.Update
End If
End If
End If
End If
**
- 下机代码:
If txtkahao.Text = "" Then
MsgBox "请输入卡号!", vbOKOnly, "警告"
txtkahao.SetFocus
Exit Sub
Else
'判断卡号输入的是否是数字
If Not IsNumeric(txtkahao.Text) Then
MsgBox "卡号请输入数字!", vbOKOnly, "警告"
txtkahao.Text = ""
txtkahao.SetFocus
Exit Sub
Else
'判断此卡号是否存在
StudentSQL = "select * from student_Info where cardno = '" & Trim(txtkahao.Text) & "'"
Set rstStudent = ExecuteSQL(StudentSQL, smsgtext)
If rstStudent.EOF Then
MsgBox "该卡号尚未注册!请重新输入!", vbOKOnly, "警告"
txtkahao.SetFocus
Exit Sub
Else
'判断该卡号是否可以使用(是否已被退卡)
If rstStudent.Fields(10) = "不使用" Then
MsgBox "该卡号已经退卡,不能下机!", vbOKOnly, "警告"
txtkahao.SetFocus
Exit Sub
Else
'判断该卡号是否正在上机
OnLineSQL = "select * from Online_Info where cardno = '" & Trim(txtkahao.Text) & "'"
Set rstOnline = ExecuteSQL(OnLineSQL, OMsgtext)
If rstOnline.EOF Then
MsgBox "该卡号没有上机!", vbOKOnly, "警告"
Exit Sub
txtkahao.SetFocus
End If
End If
End If
End If
End If
BasicDataSQL = "select * from BasicData_Info "
Set rstBasicData = ExecuteSQL(BasicDataSQL, BMsgtext)
intLineTime = (Date - DateValue(rstOnline!ondate)) * 1440 + (Hour(Time) - Hour(TimeValue(rstOnline!OnTime))) * 60 + (Minute(Time) - Minute(TimeValue(rstOnline!OnTime)))
'把固定用户、临时用户30分钟的费用分别赋给费用
fixedRate = Val(rstBasicData.Fields(0)) '把固定用户的金额赋给变量
fixedRate1 = Val(rstBasicData.Fields(1)) '把临时用户的金额赋给变量
'判断实际在线时间是否小于准备时间,若小于则消费时间为0
If intLineTime <= Val(Trim(rstBasicData.Fields(4))) Then
Label17.Caption = 0
Else
'判断实际在线时间是否小于最低消费时间,若小于消费为0
If intLineTime <= Val(Trim(rstBasicData.Fields(3))) Then
Label17.Caption = 0
Else
'实际在线时间大于最低消费时间则按单位时间算,分固定用户和临时用户
If intLineTime >= Val(Trim(rstBasicData!leastTime)) And intLineTime < Val(Trim(rstBasicData!unitTime)) And Trim(rstStudent.Fields(14)) = "固定用户" Then
Label17.Caption = fixedRate
Else
If intLineTime >= Val(Trim(rstBasicData!leastTime)) And intLineTime < Val(Trim(rstBasicData!unitTime)) And Trim(rstStudent.Fields(14)) = "临时用户" Then
Label17.Caption = fixedRate1
Else '当实际在线时间大于单位时间,就按有几个单位时间算,分固定用户和临时用户
If intLineTime > Val(Trim(rstBasicData!leastTime)) And Trim(rstStudent.Fields(14)) = "固定用户" Then
Label17.Caption = Int(intLineTime / 60 + 1) * Int(fixedRate)
Else
If intLineTime >= Val(Trim(rstBasicData!leastTime)) And Trim(rstStudent.Fields(14)) = "临时用户" Then
Label17.Caption = Int(intLineTime / 60 + 1) * Int(fixedRate1)
End If
End If
End If
End If
End If
End If
'计算余额(账户余额=原账户余额-消费金额)
curBalance = Val(rstStudent!cash) - Val(Label17.Caption)
'下机信息显示:
'下机信息显示
Label12.Caption = Date
Label10.Caption = Time
Label5.Caption = Trim(rstOnline.Fields(2))
Label6.Caption = Trim(rstOnline.Fields(3))
Label8.Caption = Trim(rstOnline.Fields(4))
Label3.Caption = Trim(rstOnline.Fields(1))
Label7.Caption = Trim(rstOnline.Fields(5))
Label11.Caption = Trim(rstOnline.Fields(6))
Label9.Caption = Trim(rstOnline.Fields(7))
Label13.Caption = intLineTime
Label16.Caption = curBalance
MsgBox "下机成功!欢迎下次再来!", vbOKOnly, "提示"
'更新学生表:
rstStudent.Fields(7) = curBalance
rstStudent.Update
rstStudent.Close
'更新上机记录表:
LineSQL = "select * from Line_Info"
Set rstLine = ExecuteSQL(LineSQL, LMsgtext)
rstLine.AddNew
rstLine.Fields(1) = Trim(txtkahao.Text)
rstLine.Fields(2) = Trim(Label5.Caption)
rstLine.Fields(3) = Trim(Label6.Caption)
rstLine.Fields(4) = Trim(Label8.Caption)
rstLine.Fields(5) = Trim(Label7.Caption)
rstLine.Fields(6) = Trim(Label11.Caption)
rstLine.Fields(7) = Trim(Label9.Caption)
rstLine.Fields(8) = Trim(Label12.Caption)
rstLine.Fields(9) = Trim(Label10.Caption)
rstLine.Fields(10) = Trim(Val(Label13.Caption))
rstLine.Fields(11) = Trim(Val(Label17.Caption))
rstLine.Fields(12) = Trim(Val(Label16.Caption))
rstLine.Fields(13) = "正常下机"
rstLine.Fields(14) = GetThisComputerName
rstLine.Update
'删除在线表中的信息:
OnLineSQL = "select * from online_Info where cardno = '" & Trim(txtkahao.Text) & "'"
Set rstOnline = ExecuteSQL(OnLineSQL, OMsgtext)
rstOnline.Delete
rstOnline.Update
lblOnlineNumber.Caption = Str(lblOnlineNumber.Caption - 1)