【机房收费系统】添加或删除用户

这一生的挚爱 提交于 2019-12-19 00:16:52

 添加和删除用户长窗体不算很难。画一个流程图逻辑就清楚了。

先看流程图部分:

添加按钮里面还嵌套一个添加用户的窗体

窗体展示:窗体特别简洁,值得注意的是combouserlevel控件,它是不可以手动输入的

禁止combouserlevel输入的代码:keyascii=0

Rem:禁止combouserlevel输入
Private Sub Combouserlevel_KeyPress(KeyAscii As Integer)
    KeyAscii = 0
End Sub

对于combouserlevel选择不同的用户级别,显示不同的信息 。查询的是user_info表

Rem:选择不同的用户级别,显示不同的信息
Private Sub Combouserlevel_click()
    Dim txtsql As String
    Dim mrcus As ADODB.Recordset
    Dim msgtext As String
    txtsql = "select *from user_info where level='" & Trim(combouserlevel.Text) & "'"
    Set mrcus = executeSQL(txtsql, msgtext)
    If mrcus.EOF Then
        MsgBox "没有数据!", vbOKOnly + vbExclamation, "警告"
    Else
        With MSFlexGrid1
         .rows = 1
         .CellAlignment = 4
         .TextMatrix(0, 0) = "用户名"
         .TextMatrix(0, 1) = "姓名"
         .TextMatrix(0, 2) = "开户人"
         Do While Not mrcus.EOF
            .rows = .rows + 1
            .CellAlignment = 4
            .TextMatrix(.rows - 1, 0) = mrcus.Fields(0)
            .TextMatrix(.rows - 1, 1) = mrcus.Fields(3)
            .TextMatrix(.rows - 1, 2) = Trim(mrcus.Fields(4)) & ""
            mrcus.MoveNext
        Loop
        End With
        mrcus.Close
    End If
 End Sub

添加:

添加用户窗体(adduser)show。判断用户信息是否为空,用户名是否存在

代码展示:

 Rem:连接user_info 表
    txtsql = "select * from user_info"
    Set mrcus = executeSQL(txtsql, msgtext)
    If Trim(txtusername.Text) = "" Then
        MsgBox "用户名不能为空,请输入用户名!", vbOKOnly + vbExclamation, "警告"
        txtusername.Text = ""
        txtusername.SetFocus
    End If
    If Trim(combouserlevel.Text) = "" Then
        MsgBox "请选择用户级别!", vbOKOnly + vbExclamation, "警告"
        combouserlevel.SetFocus
        Exit Sub
    End If
    If Trim(txtname.Text) = "" Then
        MsgBox "姓名不能为空,请输入姓名!", vbOKOnly + vbExclamation, "警告"
        txtname.Text = ""
        txtname.SetFocus
        Exit Sub
    End If
    If Trim(txtname.Text) = "" Then
        MsgBox "开户人不能为空,请输入!", vbOKOnly + vbExclamation, "警告"
        txtname.Text = ""
        txtname.SetFocus
        Exit Sub
    End If
    If Trim(txtpd.Text) = "" Then
        MsgBox "密码不能为空,请输入密码!", vbOKOnly + vbExclamation, "警告"
        txtpd.Text = ""
        txtpd.SetFocus
        Exit Sub
   Else
    If Trim(txttpd.Text) = "" Then
        MsgBox "请确认您的密码!", vbOKOnly + vbExclamation, "警告"
        txttpd.Text = ""
        txttpd.SetFocus
        Exit Sub
    End If
    If Trim(txtpd.Text) <> Trim(txttpd.Text) Then
        MsgBox "两次密码输入不一致!", vbOKOnly + vbExclamation, "警告"
        txttpd.Text = ""
        txttpd.SetFocus
    Exit Sub
    End If
    If Trim(txtusername.Text) = mrcus.Fields(0) Then
        MsgBox "该用户已经存在!", vbOKOnly + vbExclamation, "警告"
        txtusername.Text = ""
        txtusername.SetFocus
        Exit Sub
    End If
    mrcus.AddNew
    mrcus.Fields(0) = Trim(txtusername.Text)
    mrcus.Fields(2) = Trim(combouserlevel.Text)
    mrcus.Fields(3) = Trim(txtname.Text)
    mrcus.Fields(1) = Trim(txtpd.Text)
    mrcus.Fields(4) = Trim(txtp.Text)
    mrcus.Update
    mrcus.Close
    MsgBox "用户添加成功!", vbOKOnly, "提示"
    End If
End Sub

删除:

注意第一列的表头和登录的用户不能删除

'当msflexgrid1中的第一列内容和本机登录的内容一样时不能删除
            If Trim(MSFlexGrid1.TextMatrix(line - 1, 0)) = Trim(frmlogin.txtusername.Text) Then
                MsgBox "用户:" & Trim(MSFlexGrid1.TextMatrix(line - 1, 0)) & "正在登录,不能删除!", vbOKOnly + vbExclamation, "警告"
            Else

如何实现选中不连续的行,进行多行选中呢?

'判断控件是否选中,如果选中改变颜色,并加√,如果本身选中变为非选中
    If MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 3) = "√" Then
        MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 3) = ""
        
        '改变行颜色(变为没选中之前的)
        For col = 0 To MSFlexGrid1.cols - 1
            MSFlexGrid1.col = col
            MSFlexGrid1.CellBackColor = vbWhite
        Next col
    Else
        MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 3) = "√"
        '改变行颜色(选中后的颜色)
        For col = 0 To MSFlexGrid1.cols - 1
            MSFlexGrid1.col = col
            MSFlexGrid1.CellBackColor = vbRed
        Next col
    
    End If
End Sub

效果如下:用VBred突出显示选中的,并添加“√”的状态

 添加删除用户就结束了,如果大咖有更好的建议,欢迎评论在下方! 

标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!