机房收费系统——学生上机状态查看

 这个窗体都可以算成是一个小系统了，因为它包含了四个子菜单，最难的就是上机管理，下面我们就来分析 一下这个菜单吧！

这个菜单包含所有学生下线和选中学生下线，选中下机我们要达到以下效果：

代码片段：

选中下机：

 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