机房收费系统——学生上机状态查看
这个窗体都可以算成是一个小系统了,因为它包含了四个子菜单,最难的就是上机管理,下面我们就来分析 一下这个菜单吧!
这个菜单包含所有学生下线和选中学生下线,选中下机我们要达到以下效果:
代码片段:
选中下机:
Private Sub selstudentoutline_Click()
Dim sz(999) As String '这是一个数组,用来存储带“√”的学号
Dim xh(999) As String '用来存储带“√”的mshflexgrid的行号
Dim txtCash As String
Dim consumetine As String
Dim consume As String
Dim z As Integer '用来存储带“√”的学号用到的变量
Dim i As Integer '改变颜色时候调用的变量
Dim s As Integer '存带√的mshflexgrid的行号用到的变量
Dim bob As Boolean '用来标记是否点击显示全部按钮的状态,最开始默认的是false,点击全部按钮后,值为true
Dim txtsql As String
Dim msgtext As String
Dim mrc_online As ADODB.Recordset '连接on_line表
Dim mrc1 As ADODB.Recordset '代表online_info中有时间限制
Dim mrc_line As ADODB.Recordset '代表连接 line 表
Dim mrc_bas As ADODB.Recordset '代表连接Basicdate表
Dim mrc_stu As ADODB.Recordset '代表学生表
With MSHFlexGrid1
'记录选中下机的卡号,在最后一行加了一个勾,将这些记录的所有卡号信息全部存到数组sz中
i = 0
For j = 1 To .Rows - 1
If .TextMatrix(j, 5) = "√" Then
sz(i) = .TextMatrix(j, 0) '存的是卡号
xh(i) = Val(j)
i = i + 1
End If
Next j
For z = 0 To i - 1 '数组是从0开始的
'更新了表online_info与line info中的信息
txtsql = "select * from BasicData_Info"
Set mrc_bas = ExecuteSQL(txtsql, msgtext)
txtsql = "select * from student_Info where cardno='" & sz(z) & "'" & "and status='使用" & "'"
Set mrc_stu = ExecuteSQL(txtsql, msgtext)
txtsql = "select * from online_info where cardno= '" & sz(z) & " '"
Set mrc_online = ExecuteSQL(txtsql, msgtext)
'计算消费时间
consumetime = DateDiff("n", Trim(mrc_online!Date), Now)
'计算消费金额
'如果消费时间小于准备时间则不收钱,如果大于准备时间小于最短上机时间则半价,如果大于最短上机时间则按正常收费
If Val(consumetime) <= Val(mrc_bas!preparetime) Then
consume = "0"
Else
'判断是否小于最短上机时间
If Val(consumetime) < Val(mrc_bas!leasttime) Then
If Trim(mrc_stu!Type) = Trim("固定用户") Then
consume = 0.5 * mrc_bas!Rate
Else
consume = 0.5 * mrc_bas!tmprate
End If
Else
'计算消费时间
If Val(consumetime) Mod Val(mrc_bas!unittime) = 0 Then
t = Int(consumetime / mrc_bas!unittime)
Else
t = Int(consumetime / mrc_bas!unittime) + 1
End If
If mrc_stu.EOF Then
MsgBox "该同学没有注册或者是已经退卡!", 0 + 46, "提示"
Exit Sub
Else
'判断是固定用户还是临时用户
If Trim(mrc_stu!Type) = Trim("固定用户") Then
consume = t * mrc_bas.fields(0)
Else
consume = t * mrc_bas.fields(1)
End If
End If
End If
'计算余额(上机时候余额显示减去消费余额)
txtCash = Val(mrc_stu!cash) - Val(consume)
End If
'更新数据到line_info表
txtsql = "select * from line_info where cardno= '" & sz(z) & "'"
Set mrc1 = ExecuteSQL(txtsql, msgtext)
mrc1.AddNew
mrc1.fields(1) = sz(z)
mrc1.fields(2) = Trim(mrc_stu.fields(1))
mrc1.fields(3) = Trim(mrc_stu.fields(2))
mrc1.fields(4) = Trim(mrc_stu.fields(4))
mrc1.fields(5) = Trim(mrc_stu.fields(3))
mrc1.fields(6) = Trim(mrc_online.fields(6))
mrc1.fields(7) = Trim(mrc_online.fields(7))
mrc1.fields(10) = consumetime
mrc1.fields(11) = consume
mrc1.fields(12) = txtCash
mrc1.fields(13) = "正常下机"
mrc1.fields(14) = "FZH"
mrc1.Update
mrc1.Close
mrc_stu.Close
mrc_online.Close
'更新表Online_info
txtsql1 = "delete online_info where cardno= '" & sz(z) & "'"
Set mrc = ExecuteSQL(txtsql1, msgtext)
Next z
'更新mshflexgrid1的界面
For s = 0 To i - 1
.RemoveItem xh(s)
Next s
End With
frmMain.Refresh
End Sub
所有学生下机:
Private Sub allstudentoutline_Click()
Dim msgtext As String
Dim txtsql As String
Dim mrcupdate As ADODB.Recordset
Dim mrconline As ADODB.Recordset
Dim cash As String
Do While Not MSHFlexGrid1.Rows - 1
txtsql = "select * from online_info where cardno= '" & MSHFlexGrid1.TextMatrix(1, 0) & "'"
Set mrc_online = ExecuteSQL(txtsql, msgtext)
txtsql = "select * from student_info where cardno='" & MSHFlexGrid1.TextMatrix(1, 0) & "'"
Set mrc_stu = ExecuteSQL(txtsql, msgtext)
'判断数据库是否有该数据
If mrc_stu.EOF = True Then
MsgBox "该学生没有注册,请先注册!", 0 + 46, "提示"
Exit Sub
Else
consumetime = DateDiff("n", mrc_online.fields(7), Time) '计算消费时间
If Trim(mrc_stu.fields(1)) = "固定用户" Then
consume = consumetime / 2 '固定用户一分钟2元
Else
consume = consumetime / 3 '临时用户一分钟3元
End If
'更新学生表,用户余额更新
cash = Trim(mrc_stu.fields(7)) - consume
txtsql = "update student_info set cash= " & cash & "where cardno= '" & MSHFlexGrid1.TextMatrix(1, 0) & "'"
Set mrcupdate = ExecuteSQL(txtsql, msgtext)
'更新ling_info数据,添加下机
txtsql = "select * from line_info"
Set mrc_line = ExecuteSQL(txtsql, msgtext)
mrc_line.AddNew
mrc_line.fields(1) = Trim(MSHFlexGrid1.TextMatrix(1, 0))
mrc_line.fields(2) = Trim(mrc_stu.fields(1))
mrc_line.fields(3) = Trim(mrc_stu.fields(2))
mrc_line.fields(4) = Trim(mrc_stu.fields(4))
mrc_line.fields(5) = Trim(mrc_stu.fields(3))
mrc_line.fields(6) = Trim(mrc_stu.fields(6))
mrc_line.fields(7) = Trim(mrc_stu.fields(7))
mrc_line.fields(8) = Format(Now(), "yyyy-MM-dd")
mrc_line.fields(9) = Format(Now(), "HH:mm:ss")
mrc_line.fields(10) = consumetime
mrc_line.fields(11) = consume
mrc_line.fields(12) = cash
mrc_line.fields(13) = "正常下机"
mrc_line.fields(14) = "FZH"
mrc_line.Update
'更新online_info 数据,删除上机数据
txtsql = "delete * from online_info where cardno= '" & MSHFlexGrid1.TextMatrix(1, 0) & "'"
Set mrconline = ExecuteSQL(txtsql, msgtext)
MSHFlexGrid1.RemoveItem 1 '删除mshflexgrid本行数据
End If
Loop
mrc_stu.Close
mrc_line.Close
mrconline.Close
frmMain.Refresh
End Sub
mshflexgrid表的设计
Private Sub MSHFlexGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'如何选中不连续的行
Dim col As Integer
If MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 5) = "√" Then
MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 5) = ""
'改变列颜色(变为没选中之前的)
For col = 0 To MSHFlexGrid1.Cols - 1
MSHFlexGrid1.col = col
MSHFlexGrid1.CellBackColor = vbWhite
Next col
Else
MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 5) = "√"
'改变行颜色(选中后的颜色)
For col = 0 To MSHFlexGrid1.Cols - 1
MSHFlexGrid1.col = col
MSHFlexGrid1.CellBackColor = &HFFFF00
Next col
End If
'判断是否选中数据,如果选中数据那么就会让你的修改按钮为**状态
If MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 5) = "√" Then
selstudentoutline.Enabled = True
Else
selstudentoutline.Enabled = False
End If
End Sub
显示全部:
Private Sub showall_Click()
Dim msgtext As String
Dim mrc_online As ADODB.Recordset
txtsql = "select * from online_info "
Set mrc_online = ExecuteSQL(txtsql, msgtext)
If mrc_online.EOF = True Then
MsgBox "无人上机!", 0 + 46, "警告"
Exit Sub
End If
With MSHFlexGrid1
.Rows = 1
.ColWidth(2) = 1900
.TextMatrix(0, 0) = "卡号"
.TextMatrix(0, 1) = "姓名"
.TextMatrix(0, 2) = "上机日期"
.TextMatrix(0, 3) = "上机时间"
.TextMatrix(0, 4) = "机器名"
.TextMatrix(0, 5) = "选中"
Do While Not mrc_online.EOF
.Rows = .Rows + 1
.CellAlignment = 4
.TextMatrix(.Rows - 1, 0) = mrc_online.fields(0)
.TextMatrix(.Rows - 1, 1) = mrc_online.fields(3)
.TextMatrix(.Rows - 1, 2) = mrc_online.fields(6)
.TextMatrix(.Rows - 1, 3) = mrc_online.fields(7)
.TextMatrix(.Rows - 1, 4) = mrc_online.fields(8)
mrc_online.MoveNext
Loop
End With
mrc_online.Close
End Sub