机房收费系统——选中下机

“学生上机状态查看”窗体中相对较难的部分是选中下机，而选中下机的重点在于如何实现“选中”的，以下是我的流程图和部分代码☟☟☟

全部下机和选中下机流程图

MSFlexGrid控件-选中行

Private Sub myflexgrid_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim col As Integer
    '选中相应行时，在选中行的第6列显示√
     If myflexgrid.TextMatrix(myflexgrid.Row, 5) = "√" Then
        myflexgrid.TextMatrix(myflexgrid.Row, 5) = ""
        '恢复颜色
        For col = 0 To myflexgrid.Cols - 1
        myflexgrid.col = col
        myflexgrid.CellBackColor = vbWhite
        Next col
        Else
        myflexgrid.TextMatrix(myflexgrid.Row, 5) = "√"
        '改变颜色
        For col = 0 To myflexgrid.Cols - 1
        myflexgrid.col = col
        myflexgrid.CellBackColor = &HFFFF00
        Next col
        End If
End Sub

实现选中功能后，就要设计选中下机部分的代码了，在这儿我们需要考虑到该功能不只是要选中用户下机，还需要将该卡号消费金额算出来，最后再更新相关数据表。

实现该功能的代码如下

Private Sub instudents_Click()
    Dim sz(999) As String      '用来存放带√的学号
    Dim xh(999) As String       '用来存放行号
    Dim txtcash As String       '
    Dim cosumedate As String
    Dim cosumetime As String   '
    Dim consume As String       '
    Dim Msgtext As String
    Dim z As Integer            '存放带√的变量
    Dim i As Integer            '存放改变颜色时候的变量
    Dim s As Integer            '存放行号用的变量
    Dim j As Integer
      Dim txtsqlbas As String
      Dim mrcbas As adodb.Recordset
      txtsqlbas = "select * from basicdata_info"  '连接basicadata表
      Set mrcbas = ExecuteSQL(txtsqlbas, Msgtext)
      Dim txtsqlonl As String
      Dim mrconl As adodb.Recordset
      txtsqlonl = "select * from online_info "  '连接online表
      Set mrconl = ExecuteSQL(txtsqlonl, Msgtext)
        If mrconl.EOF Then
            MsgBox "当前无上机人员", 48, "提示"
            Else
            
            With myflexgrid
        If .RowSel = 0 Then
            MsgBox "请选择学生", 48, "提示"
            Exit Sub
        End If
            End With
        
            With myflexgrid
                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开始
    Dim txtSQLlin As String
    Dim mrclin As adodb.Recordset
    txtSQLlin = "select * from line_info where cardno = '" & sz(z) & "' and status = '正常上机'"
    Set mrclin = ExecuteSQL(txtSQLlin, Msgtext)  '选择line表中的数据
    
    Dim StrCPN As String * 10
    Do While mrclin.EOF = False
       mrclin.Fields(8) = Format(Date, "yyyy-mm-dd")
       
       mrclin.Fields(9) = Time
       
       mrclin.Fields(13) = "正常下机"
        cosumedate = DateDiff("n", mrclin.Fields(6), mrclin.Fields(8))
        cosumetime = DateDiff("n", mrclin.Fields(7), mrclin.Fields(9))
        mrclin.Fields(10) = (Val(cosumedate) + Val(cosumetime)) + 1
         If mrconl.Fields(1) = "固定用户" Then    '计算钱数
          mrclin.Fields(11) = Format(mrclin.Fields(10) / mrcbas.Fields(2) * mrcbas.Fields(0), "0.00")
          mrclin.Fields(11) = Format(mrclin.Fields(10) / mrcbas.Fields(2) * mrcbas.Fields(1), "0.00")
          End If
          mrclin.MoveNext
          Loop
          mrconl.Close
          Dim deleotxtsql As String
          Dim deleomrc As adodb.Recordset
          Dim deleomsgtext As String
            deleotxtsql = "delete from Online_Info where cardno='" & sz(z) & "'"
            Set deleomrc = ExecuteSQL(deleotxtsql, deleomsgtext)
          
          Next z
          For s = 0 To i - 1
             .RemoveItem xh(s)
          Next s
        
          txtsqlonl = " select * from online_info "
          Set mrconl = ExecuteSQL(txtsqlonl, Msgtext)
          MsgBox "操作完成！", 48, "提示"
          
          End With
        End If
End Sub