机房收费系统--系统用户管理模块和主窗体建立（三）

添加删除用户：

添加用户和删除用户窗口是选择一个身份进行添加和删除。当单击添加时候判断用户身份，之后显示添加窗口，填入信息之后，则添加用户成功。

当单击用户身份的时候下面的msflexgrid控件会显示当前身份的的所有用户名，当单击选中一个按删除按钮就会删除其用户。

具体代码如下

添加和删除窗体代码如下：

Option Explicit

Dim currentRow As Integer

Private Sub CmdAddUser_Click()
    If Not Testtxt(Combo1.Text) Then
        MsgBox "请选择要添加的用户身份！", vbOKOnly + vbExclamation, "警告"
        Combo1.SetFocus
        Exit Sub
    End If
    FrmAddUser.Show
End Sub

Private Sub Combo1_Click()
    '选中身份自动填入该身份的记录
    Dim objrs As ADODB.Recordset
    Dim strsql As String
    Dim msgtext As String
    Dim a As Integer
    strsql = "select * from User_Info where Status='" & Trim(Combo1.Text) & "'"
    Set objrs = ExecuteSQL(strsql, msgtext)
    With MyMSFlexGrid
        .Rows = 1
        .Cols = 3
        .CellAlignment = 4
        .TextMatrix(0, 0) = "用户名"
        .TextMatrix(0, 1) = "姓名"
        .TextMatrix(0, 2) = "开户名"
        Do While Not (objrs.EOF)
            .Rows = .Rows + 1
            .TextMatrix(.Rows - 1, 0) = Trim(objrs.Fields(0).Value)
            .TextMatrix(.Rows - 1, 1) = Trim(objrs.Fields(5).Value)
            .TextMatrix(.Rows - 1, 2) = Trim(objrs.Fields(3).Value)
            objrs.MoveNext
        Loop
    End With
    objrs.Close
End Sub

Private Sub Combo1_KeyPress(KeyAscii As Integer)
    KeyAscii = 0
End Sub

Private Sub Command2_Click()
    Dim objrs As ADODB.Recordset
    Dim strsql As String
    Dim msgtext As String
    Dim I As Integer
    '没有记录不能删除
    If currentRow < 1 Then
        MsgBox "没有要删除的内容！请重新选择！", vbOKOnly + vbExclamation, "警告"
        Exit Sub
    Else
        '删除当前选中记录
        If Trim(MyMSFlexGrid.TextMatrix(currentRow, 0)) = Trim(UserName) Then
            MsgBox "该用户不能删除！", vbOKOnly + vbExclamation, "警告"
            Exit Sub
        End If
        strsql = "select * from User_Info where User_Name='" & Trim(MyMSFlexGrid.TextMatrix(currentRow, 0)) & "'and Teachername='" & Trim(MyMSFlexGrid.TextMatrix(currentRow, 1)) & "'"
        Set objrs = ExecuteSQL(strsql, msgtext)
        I = MsgBox("真的要删除吗？", vbYesNo, "询问")
        If I = vbYes Then
            objrs.Delete
            objrs.MoveNext
            objrs.Close
            Call Combo1_Click
            MsgBox "删除成功！", vbOKOnly + vbExclamation, "警告"
        End If
    End If
End Sub

Private Sub Command3_Click()
    Unload Me
End Sub

Private Sub MyMSFlexGrid_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    '判断行号
    With MyMSFlexGrid
        .Row = .MouseRow
        currentRow = .Row
        .Col = 0
    End With
End Sub

Private Sub MyMSFlexGrid_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    '选中要删除的行
    With MyMSFlexGrid
        If .Col > 1 Then
            .RowSel = currentRow
            .ColSel = .ColSel - 1
        End If
    End With
End Sub

添加窗体代码如下：

Private Sub CmdCancel_Click()
    Unload Me
End Sub

Private Sub CmdOk_Click()
    Dim objrs As ADODB.Recordset
    Dim strsql As String
    Dim msgtext As String
    '判断输入信息的正确性
    '==============================================================
    If Not Testtxt(TxtUser.Text) Then
        MsgBox "用户名不能为空！", vbOKOnly + vbExclamation, "警告"
        TxtUser.Text = ""
        TxtUser.SetFocus
        Exit Sub
    End If
    If Not Testtxt(TxtName.Text) Then
        MsgBox "姓名不能为空！", vbOKOnly + vbExclamation, "警告"
        TxtName.Text = ""
        TxtName.SetFocus
        Exit Sub
    End If
    If Not Testtxt(TxtcomputerName.Text) Then
        MsgBox "机器名不能为空！", vbOKOnly + vbExclamation, "警告"
        TxtcomputerName.Text = ""
        TxtcomputerName.SetFocus
        Exit Sub
     End If
    If Trim(TxtPassword.Text) <> Trim(TxtEnsurePassword.Text) Then
        MsgBox "两个密码不一致，请重新输入！", vbOKOnly + vbExclamation, "警告"
        TxtPassword.Text = ""
        TxtEnsurePassword.Text = ""
        TxtPassword.SetFocus
        Exit Sub
    End If
    '========================================================================
    strsql = "select * from User_Info"
    Set objrs = ExecuteSQL(strsql, msgtext)
    '判断用户名是否重名
    If objrs.Fields(0) = Trim(TxtUser.Text) Then
        MsgBox "该用户名已经存在，请重新输入用户名！", vbOKOnly + vbExclamation, "警告"
        TxtUser.Text = ""
        TxtUser.SetFocus
        Exit Sub
    Else
        '添加用户名
        objrs.AddNew
        objrs.Fields(0) = Trim(TxtUser.Text)
        objrs.Fields(1) = Trim(TxtPassword.Text)
        objrs.Fields(2) = Trim(TxtStatus.Text)
        objrs.Fields(4) = Trim(TxtcomputerName.Text)
        objrs.Fields(5) = Trim(TxtName.Text)
        objrs.Update
        objrs.Close
        MsgBox "添加用户成功！", vbOKOnly + vbExclamation, "添加成功"
        Unload Me
    End If
End Sub

Private Sub Form_Load()
    TxtStatus.Text = FrmAddDeleteUser.Combo1.Text
End Sub