這個窗體都可以算成是一個小系統了，因為它包含了四個子選單，最難的就是上機管理，下面我們就來分析 一下這個選單吧！

這個選單包含所有學生下線和選中學生下線，選中下機我們要達到以下效果：

程式碼片段：

選中下機：

 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