机房自己计划一个月完成,可是中途时间有点紧,所以往后推迟了半个月,说起机房,最重要的就是逻辑,做完机房最大的感受就是首先要把逻辑搞清,不然越做越乱,只会给自己添加负担,让自己的思路一塌糊涂。
在敲机房的时候,总结了几条,和大家分享:
1.代码格式要正确、清晰。以便于后面调错。
2.注释要简洁、有力。
3.做组合查询、上下机、结账时一定要先画流程图。
4.结账要分清是谁给谁结账,结的什么账。
5.数据库中的类型要搞清楚,有的时候不是程序的错误,而是数据库中有错误。
下面是一些重要的代码和大家分享:
上机代码:
Private Sub cmdUP_Click()
Dim txtSQL As String
Dim MsgText As String
Dim mrc As ADODB.Recordset
Dim mrc1 As ADODB.Recordset
Dim mrc2 As ADODB.Recordset
Dim mrc3 As ADODB.Recordset
Dim mrc4 As ADODB.Recordset
'链接basicdata表
txtSQL = "select * from basicdata_info "
Set mrc2 = ExecuteSQL(txtSQL, MsgText)
'链接line表
txtSQL = "select * from line_info "
Set mrc3 = ExecuteSQL(txtSQL, MsgText)
'online表总记录数
txtSQL = "select * from online_info "
Set mrc4 = ExecuteSQL(txtSQL, MsgText)
'判断卡号是否为空
If txtcardno.Text = "" Then
MsgBox "卡号不能为空。", vbOKOnly + vbExclamation, "提示"
txtcardno.SetFocus
GoTo 1
End If
'判断卡号是否为数字
If Not IsNumeric(Trim(txtcardno.Text)) Then
MsgBox "请输入数字!", vbOKOnly + vbExclamation, "警告"
txtcardno.Text = ""
txtcardno.SetFocus
Exit Sub
End If
'链接学生表
txtSQL = "select * from student_info where cardno='" & Trim(txtcardno.Text) & "'and status='使用'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
'判断卡号是否退卡
If mrc.EOF Then
MsgBox "此卡已经退卡", vbOKOnly + vbExclamation, "提示"
txtcardno.Text = ""
txtcardno.SetFocus
GoTo 1
Else
'链接online表
txtSQL = "select * from online_info where cardno='" & Trim(txtcardno.Text) & "'"
Set mrc1 = ExecuteSQL(txtSQL, MsgText)
'判断此卡是否上机
If mrc1.EOF = False Then
MsgBox "此卡正在上机", vbOKOnly + vbExclamation, "提示"
'调用正在上机信息到页面
txtcardno.Text = mrc1!cardno
txtType.Text = mrc1!cardtype
txtSNo.Text = mrc1!studentNo
txtSName.Text = mrc1!studentName
txtDepartment.Text = mrc1!department
txtSex.Text = mrc1!sex
txtOnDate.Text = mrc1!ondate
txtOnTime.Text = mrc1!ontime
txtcardno.SetFocus
Else
'判断余额
If Val(mrc.Fields(7)) < Trim(mrc2.Fields(5)) Then
MsgBox "余额不足,请先充值。"
txtcardno.SetFocus
GoTo 1
Else
'调用学生信息到输入框。上机成功
txtcardno.Text = mrc.Fields(0)
txtType.Text = mrc.Fields(14)
txtSNo.Text = mrc.Fields(1)
txtSName.Text = mrc.Fields(2)
txtDepartment.Text = mrc.Fields(4)
txtSex.Text = mrc.Fields(3)
txtcash.Text = mrc.Fields(7)
txtOnDate.Text = Date
txtOnTime.Text = Time
txtOffDate.Text = ""
txtOffTime.Text = ""
txtCMoney.Text = ""
txtCTime = ""
End If
End If
End If
'1 链接online表
txtSQL = "select * from online_info where cardno='" & Trim(txtcardno.Text) & "'"
Set mrc1 = ExecuteSQL(txtSQL, MsgText)
With mrc1
.AddNew
.Fields(0) = Trim(txtcardno.Text)
.Fields(1) = Trim(txtType.Text)
.Fields(2) = Trim(txtSNo.Text)
.Fields(3) = Trim(txtSName.Text)
.Fields(4) = Trim(txtDepartment.Text)
.Fields(5) = Trim(txtSex.Text)
.Fields(6) = Date
.Fields(7) = Time
.Fields(8) = VBA.Environ("computername")
.Fields(9) = Now
.Update
.Close
End With
'添加line表
With mrc3
.AddNew
.Fields(1) = Trim(txtcardno.Text)
.Fields(2) = Trim(txtSNo.Text)
.Fields(3) = Trim(txtSName.Text)
.Fields(4) = Trim(txtDepartment.Text)
.Fields(5) = Trim(txtSex.Text)
.Fields(6) = Date
.Fields(7) = Time
.Fields(13) = "正在上机"
!COMPUTER = VBA.Environ("computername")
.Update
.Close
End With
Timer2.Enabled = True
MsgBox "上机成功", vbInformation, "提示"
'更新学生表
With mrc
.Fields(11) = "未结账"
.Update
.Close
End With
End Sub
下机代码:
Private Sub cmdOffLine_Click() '下机
Dim txtSQL As String
Dim MsgText As String
Dim mrc As ADODB.Recordset
Dim mrc1 As ADODB.Recordset
Dim mrc2 As ADODB.Recordset
Dim mrc3 As ADODB.Recordset
Dim mrc4 As ADODB.Recordset
Dim mrc5 As ADODB.Recordset
Dim ct As String
Dim linetime As Integer '用于存储实际在线时间
'链接学生表
txtSQL = "select * from student_info where cardno='" & Trim(txtcardno.Text) & "' and status='使用'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
'online表
txtSQL = "select * from online_info where cardno='" & Trim(txtcardno.Text) & "'"
Set mrc1 = ExecuteSQL(txtSQL, MsgText)
'2
txtSQL = "select * from online_info "
Set mrc2 = ExecuteSQL(txtSQL, MsgText)
'3 基本数据表
txtSQL = "select * from basicdata_info "
Set mrc3 = ExecuteSQL(txtSQL, MsgText)
'4 上机记录
txtSQL = "select * from line_info where cardno='" & Trim(txtcardno.Text) & "' and status='正在上机'"
Set mrc4 = ExecuteSQL(txtSQL, MsgText)
'5 online 记录条数
txtSQL = "select * from online_info"
Set mrc5 = ExecuteSQL(txtSQL, MsgText)
If Not IsNumeric(Trim(txtcardno.Text)) Then
MsgBox "请输入卡号!", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
'页面更新信息
If mrc1.EOF Then
MsgBox "此卡没有上机", vbInformation, "提示"
GoTo 1
Else
txtcardno.Text = txtcardno.Text
txtSNo.Text = mrc1!studentNo
txtType.Text = mrc1!cardtype
txtSName.Text = mrc1!studentName
txtSex.Text = mrc1!sex
txtDepartment.Text = mrc1!department
txtOnTime.Text = mrc1!ontime
txtOnDate.Text = mrc1!ondate
txtOffTime.Text = Time
txtOffDate.Text = Format(Date, "yyyy-mm-dd")
' '在线时长计算
linetime = (Date - DateValue(mrc1!ondate)) * 1440 + (Hour(Time) - Hour(TimeValue(mrc1!ontime))) * 60 + (Minute(Time) - Minute(TimeValue(mrc1!ontime))) '时间单位为分钟
' If linetime < Trim(mrc3.Fields(4)) Then
' txtcash = mrc.Fields(7)
' txtCTime.Text = "0"
' txtCMoney.Text = "0"
' Ccash = "0"
' Else
If Trim(mrc.Fields(14)) = "固定用户" Then '固定用户消费
Money = Trim(mrc3.Fields(0)) * Int(((linetime / mrc3.Fields(2)) + 1))
Ccash = Trim(mrc.Fields(7)) - Trim(Money)
mrc.Fields(7) = Trim(mrc!cash) - Money
txtCTime.Text = linetime
txtcash.Text = Ccash
txtCMoney.Text = Money
mrc.Fields(8) = Money
mrc.Update
Else
Money = Trim(mrc3.Fields(1)) * Int(((linetime / mrc3.Fields(2)) + 1))
Ccash = Trim(mrc.Fields(7)) - Trim(Money)
mrc.Fields(7) = Trim(mrc!cash) - Money
txtcash.Text = Ccash
txtCTime.Text = linetime
txtCMoney.Text = Money
mrc.Fields(8) = Money
mrc.Update
End If
' End If
'删除line表中上机的记录
txtSQL = "select * from line_info where cardno='" & Trim(txtcardno.Text) & "'and status='正在上机'"
Set mrc4 = ExecuteSQL(txtSQL, MsgText)
mrc4.Delete
mrc4.Update
'更新line表
With mrc4
.AddNew
.Fields(1) = Trim(txtcardno.Text)
.Fields(2) = Trim(txtSNo.Text)
.Fields(3) = Trim(txtSName.Text)
.Fields(4) = Trim(txtDepartment.Text)
.Fields(5) = Trim(txtSex.Text)
.Fields(6) = mrc1!ondate
.Fields(7) = mrc1!ontime
!COMPUTER = VBA.Environ("computername")
!offdate = Trim(txtOffDate.Text)
!offtime = Trim(txtOffTime.Text)
!consumetime = Trim(txtCTime.Text)
!consume = Trim(txtCMoney.Text)
!cash = Trim(Ccash) & ""
!Status = "正常下机"
.Update
.Close
End With
'更新online表
mrc1.Delete
mrc1.Update
mrc1.Close
End If
'5 online 记录条数
1: Dim mrcOnline As ADODB.Recordset
Dim OnlineSQL As String
Dim OnMsgtext As String
'显示正在上机的人数
OnlineSQL = "select * from OnLine_Info"
Set mrcOnline = ExecuteSQL(OnlineSQL, OnMsgtext)
If mrcOnline.EOF = True Then
Label21.Caption = 0
Else
Label21.Caption = mrcOnline.RecordCount
End If
End Sub
组合查询代码:
Private Sub btnInquire_Click()
Dim ctrl As Control
Dim mrc As ADODB.Recordset
Dim txtSQL As String
Dim MsgText As String
Dim i, iCols As Integer '让所有列都居中显示文字
Dim a0, a1, a2
a0 = Text1.Text
a1 = Text2.Text
a2 = Text3.Text
'检查条件输入
If Trim(Combo1.Text) = "" Or Trim(Combo2(0).Text) = "" Or Trim(Text1.Text) = "" Then
MsgBox "请输入完整的查询条件", , "提示"
Exit Sub
End If
iCols = MSHFlexGrid1.Cols
For i = 0 To iCols - 1
MSHFlexGrid1.ColAlignment(i) = flexAlignCenterCenter
Next i
txtSQL = "select * from student_Info where "
txtSQL = txtSQL & " " & field(Combo1.Text) & " " & Trim(Combo2(0).Text) & "'" & Trim(a0) & "'"
If Trim(Combo3(0).Text <> "") Then '第一个组合关系存在
If Trim(Combo4.Text) = "" Or Trim(Combo2(1).Text = "") Or Trim(a0 = "") Then
MsgBox "你已经选择了第一个组合关系,请输入第二行查询条件", , "提示"
Exit Sub
Else
txtSQL = txtSQL & field(Trim(Combo3(0).Text)) & " " & field(Combo4.Text) & Combo2(1).Text & "'" & Trim(a1) & "'"
End If
End If
If Trim(Combo3(1).Text <> "") Then '第二个组合关系存在
If Trim(Combo5.Text) = "" Or Trim(Combo2(2).Text) = "" Or Trim(a2) = "" Then
MsgBox "你已经选择了第二个组合关系,请输入第三行查询条件", , "提示"
Exit Sub
Else
txtSQL = txtSQL & field(Combo3(1).Text) & " " & field(Combo5.Text) & Combo2(2).Text & "'" & Trim(a2) & "'"
End If
End If
Set mrc = ExecuteSQL(txtSQL, MsgText)
If mrc.EOF = True Then '检查信息是否存在,如果不存在给出提示并清空所有文本框
MsgBox "没有查询到结果,可能会你输入的信息不存在,或者信息矛盾"
MSHFlexGrid1.Clear
'...清空所有文本框
Exit Sub
End If
With MSHFlexGrid1
.Rows = 1
.TextMatrix(0, 0) = "卡号"
.TextMatrix(0, 1) = "学号"
.TextMatrix(0, 2) = "姓名"
.TextMatrix(0, 3) = "性别"
.TextMatrix(0, 4) = "系别"
.TextMatrix(0, 5) = "年级"
.TextMatrix(0, 6) = "班级"
.TextMatrix(0, 7) = "金额"
.TextMatrix(0, 8) = "类型"
.TextMatrix(0, 9) = "状态"
.TextMatrix(0, 10) = "日期"
.TextMatrix(0, 11) = "时间"
Do While Not mrc.EOF
.Rows = .Rows + 1
.TextMatrix(.Rows - 1, 0) = Trim(mrc!cardno)
.TextMatrix(.Rows - 1, 1) = Trim(mrc!studentNo)
.TextMatrix(.Rows - 1, 2) = Trim(mrc!studentName)
.TextMatrix(.Rows - 1, 3) = Trim(mrc!sex)
.TextMatrix(.Rows - 1, 4) = Trim(mrc!department)
.TextMatrix(.Rows - 1, 5) = Trim(mrc!grade)
.TextMatrix(.Rows - 1, 6) = Trim(mrc!Class)
.TextMatrix(.Rows - 1, 7) = Trim(mrc!cash)
.TextMatrix(.Rows - 1, 8) = Trim(mrc!Type)
.TextMatrix(.Rows - 1, 9) = Trim(mrc!Status)
.TextMatrix(.Rows - 1, 10) = Trim(mrc!Date)
.TextMatrix(.Rows - 1, 11) = Trim(mrc!Time)
mrc.MoveNext
Loop
End With
mrc.Close
End Sub
实时动态查询余额代码:
Private Sub Timer2_Timer()
Dim txtSQL As String
Dim MsgText As String
Dim mrcOnL As ADODB.Recordset
Dim mrcStu As ADODB.Recordset
Dim mrcBas As ADODB.Recordset
Dim mrc5 As ADODB.Recordset
Dim Balance As Integer
'将OnLine表与student表进行连接
txtSQL = "select cash from student_Info,OnLine_Info where
student_Info.cardno=OnLine_Info.cardno "
Set mrcStu = ExecuteSQL(txtSQL, MsgText)
txtSQL = "select * from online_info"
Set mrcOnL = ExecuteSQL(txtSQL, MsgText)
If mrcOnL.EOF Then
Timer2.Enabled = False '如果数据库为空,则Timer停止
Else
mrcOnL.MoveFirst '从第一条记录开始查询
End If
ReDim DynCard(mrcOnL.RecordCount) As String '定义卡号数组
For Intindex = 0 To mrcOnL.RecordCount - 1
DynCard(Intindex) = mrcOnL!cardno '查找第一条记录的卡号
cardnoo = DynCard(Intindex) '将查找到的卡号赋值给cardnoo,便于后面SQL查询
txtSQL = "select * from OnLine_Info where cardno='" & Trim(cardnoo) & "'" '进行表查询
Set mrc5 = ExecuteSQL(txtSQL, MsgText)
txtSQL = "select * from BasicData_Info "
Set mrcBas = ExecuteSQL(txtSQL, MsgText)
'计算上机时长
intlinetime = (Date - DateValue(mrcOnL!ondate)) * 1440 _
+ (Hour(Time) - Hour(TimeValue(mrcOnL!ontime))) * 60 _
+ (Minute(Time) - Minute(TimeValue(mrcOnL!ontime)))
'计算余额
If Trim(mrcOnL.Fields(1)) = "临时用户" Then '若为临时用户,计算余额
Balance = Trim(mrcStu.Fields(0)) - (Int(intlinetime / mrcBas.Fields(2)) + 1) * (Trim(mrcBas.Fields(1)))
Else '若为固定用户,消费金额的计算
Balance = Trim(mrcStu.Fields(0)) - (Int(intlinetime / mrcBas.Fields(2)) + 1) * (Trim(mrcBas.Fields(0)))
End If
If Val(Balance) > 0 And Val(Balance) <= mrcBas.Fields(5) Then '如果余额大于0且小于2则给出提醒
MsgBox DynCard(Intindex) & ",您卡内的金额已不足2元,请尽快充值!", vbOKOnly + vbInformation, "提示"
mrcc.MoveNext
End If
If Balance <= 0 Then '如果余额小于等于0元,则强制下机
MsgBox DynCard(Intindex) & ",您卡内金额不足,即将下机", vbOKOnly + vbExclamation, "警告"
txtcardno.Text = mrcOnL.Fields(0)
MDIForm1.cmdOffLine = True
mrcOnL.MoveNext
mrcStu.MoveNext
End If
Next
' Loop
End Sub
大家做机房的时候可以参考我的代码,如有发现比较好的代码,在下面评论。谢谢。