c用户管理.frm

系统实战与解析书中的例4 排课系统例子的源码

      End
   End
End
Attribute VB_Name = "C用户管理"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs As ADODB.Recordset
Dim SQL As String
Dim msg As String
Dim index As Integer
Dim flag As String '判断是新增加的记录还是修改记录
Private Sub Form_Load()
    Dim strItem As String
    '初始化下拉框
    CboSelect.AddItem "教师"
    CboSelect.AddItem "管理人员"
    CboSelect.ListIndex = 0
    Call LoadData '装载用户数据
End Sub
Private Sub LoadData()
    Dim strItem As String
    '得到用户信息
    SQL = " select * from 用户信息表 order by 用户ID"
    Set rs = Nothing
    Set rs = SelectSQL(SQL, msg)
    ListUser.Clear
    If rs.RecordCount > 0 Then
        Do While (Not rs.EOF) And (Not rs.BOF)
            strItem = Trim(rs.Fields(0)) & ":" & Trim(rs.Fields(1))
            ListUser.AddItem (strItem)
            rs.MoveNext
        Loop
        rs.MoveFirst
        ListUser.ListIndex = 0
    Else
        MsgBox ("目前没有用户信息！")
        '控件可用性
        CmdAdd.Enabled = True: CmdModify.Enabled = False: CmdDelete.Enabled = False
        cmdCancel.Enabled = False: CmdSave.Enabled = False
        Exit Sub
    End If
    Call FixData '在文本框中显示详细信息
    '控件可用性
    CmdAdd.Enabled = True: CmdModify.Enabled = True: CmdDelete.Enabled = True
    cmdCancel.Enabled = False: CmdSave.Enabled = False
End Sub
Private Sub FixData()
    Dim UserID As String
    '显示具体信息
    If ListUser.ListCount > 0 Then
        UserID = Left(Trim(ListUser.Text), 6)
    Else
        Exit Sub
    End If
    '查找数据
    rs.MoveFirst
    rs.Find ("用户ID='" & UserID & "'")
    '显示数据
    txtUserId.Text = Trim(rs.Fields("用户ID"))
    txtName.Text = Trim(rs.Fields("用户名称"))
    txtPassword.Text = Trim(rs.Fields("密码"))
    CboSelect.Text = Trim(rs.Fields("用户类别"))
    txtPhone.Text = Trim(rs.Fields("电话"))
    txtEmail.Text = Trim(rs.Fields("邮箱"))
    '控件可用性
    CmdModify.Enabled = True: CmdDelete.Enabled = True: CmdAdd.Enabled = True
    CmdSave.Enabled = False: cmdCancel.Enabled = False
End Sub

Private Sub ControlActiveX(kind As String, flag As Boolean)
    '控制控件
    If kind = "Add" Or kind = "Delete" Or kind = "Save" Then
        txtUserId.Text = ""
        txtName.Text = ""
        txtPassword.Text = ""
        CboSelect.ListIndex = 0
        txtPhone.Text = ""
        txtEmail.Text = ""
    End If
    If kind = "Modify" Then
        txtUserId.Enabled = False
    Else
        txtUserId.Enabled = flag
    End If
    txtName.Enabled = flag
    txtPassword.Enabled = flag
    CboSelect.Enabled = flag
    txtPhone.Enabled = flag
    txtEmail.Enabled = flag
    ListUser.Enabled = Not flag
End Sub

Private Sub CboStu_Click()
    Call LoadData  '重新装载数据
End Sub
Private Sub CmdAdd_Click()
    '可用性，清空数据
    Call ControlActiveX("Add", True)
    '设置标志flag
    flag = "Add"
    '添加、修改、删除按钮不可用，取消、保存按钮可用
    CmdAdd.Enabled = False: CmdModify.Enabled = False: CmdDelete.Enabled = False
    cmdCancel.Enabled = True: CmdSave.Enabled = True
End Sub
Private Sub CmdModify_Click()
    '修改操作
    If rs.RecordCount > 0 Then
        '可用性
        Call ControlActiveX("Modify", True)
        '设置标志flag
        flag = "Modify"
        '添加、修改、删除按钮不可用，取消、保存按钮可用
        cmdCancel.Enabled = True: CmdSave.Enabled = True
        CmdAdd.Enabled = False: CmdModify.Enabled = False: CmdDelete.Enabled = False
    Else
        MsgBox ("没有可以修改的数据!")
    End If
End Sub
Private Sub CmdDelete_Click()
'删除操作
    On Error GoTo ErrMsg
    If txtUserId.Text = "" Then
        MsgBox ("选择需要删除的用户信息！")
        Exit Sub
    End If
    If rs.RecordCount > 0 Then
         msg = MsgBox("删除该条记录吗?", vbYesNo)
         If msg = vbYes Then
            rs.Delete
            Call LoadData '重新装载数据
            '清空文本框,重新设置下拉框
            Call ControlActiveX("Delete", False)
            '按钮可用性处理
            CmdAdd.Enabled = True: CmdModify.Enabled = False: CmdDelete.Enabled = True
            CmdSave.Enabled = False: cmdCancel.Enabled = False
            MsgBox ("成功删除的数据!")
         End If
     Else
         MsgBox ("没有可删除的数据!")
    End If
    Exit Sub
ErrMsg:
         MsgBox Err.Description, vbExclamation, "出错"
End Sub
Private Sub cmdCancel_Click()
    '取消操作
    Call FixData '设置数据
    ListUser.Enabled = True
    '修改、删除、添加按钮可用,保存和取消按钮不可用
    CmdModify.Enabled = True: CmdDelete.Enabled = True: CmdAdd.Enabled = True
    CmdSave.Enabled = False: cmdCancel.Enabled = False
End Sub
Private Function CheckData() As Boolean
    '检查数据的合法性
    Dim rst As ADODB.Recordset
    '检查非空性
    If (Trim(txtUserId.Text) = "") Then
        MsgBox ("用户ID不能为空！")
        CheckData = False
        Exit Function
    ElseIf Len(Trim(txtUserId.Text)) <> 6 Then
        MsgBox ("用户ID不是6位！")
        CheckData = False
        Exit Function
    End If
    '检查唯一性
    SQL = " select 用户ID from 用户信息表 where 用户ID='" & Trim(txtUserId.Text) & "'"
    Set rst = SelectSQL(SQL, msg)
    If flag = "Add" And rst.RecordCount > 0 Then
        MsgBox ("用户ID，重复添加!")
        rst.Close
        CheckData = False
        Exit Function
    End If
    CheckData = True '合法
End Function
Private Sub setData()
    rs.Fields("用户ID") = Trim(txtUserId.Text)
    rs.Fields("用户名称") = Trim(txtName.Text)
    rs.Fields("密码") = Trim(txtPassword.Text)
    rs.Fields("用户类别") = Trim(CboSelect.Text)
    rs.Fields("电话") = Trim(txtPhone.Text)
    rs.Fields("邮箱") = Trim(txtEmail.Text)
End Sub
Private Sub CmdSave_Click()
    On Error GoTo ErrMsg
    If Not CheckData Then Exit Sub '如果数据不合法退出
    If flag = "Modify" Then '如果是修改数据
        msg = MsgBox("您确实要修改这条数据吗?", vbYesNo)
        If msg = vbYes Then
            Call setData '赋值
        Else
            Exit Sub
        End If
    ElseIf flag = "Add" Then '如果是添加新数据
        rs.AddNew
        Call setData
    End If
    '更新数据
    rs.Update
    Call LoadData '重新装载数据
    '控件清空和可用性
    Call ControlActiveX("Save", False)
    CmdModify.Enabled = True: CmdDelete.Enabled = True: CmdAdd.Enabled = True
    CmdSave.Enabled = False: cmdCancel.Enabled = False
    If flag = "Add" Then
        MsgBox ("成功添加数据!")
    Else
        MsgBox ("成功更新数据!")
    End If
    Exit Sub
ErrMsg:
    MsgBox Err.Description, vbExclamation, "出错"
End Sub
Private Sub CmdExit_Click()
'退出操作
    排课系统.Enabled = True
    rs.Close
    Unload Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
'退出操作
    排课系统.Enabled = True
    Unload Me
End Sub
Private Sub ListUser_Click()
    Call FixData
End Sub