a班级设置.frm

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

End Sub
Private Sub LoadData()
'装载数据
    Dim list As ListItem
    Dim key As String
    Set rs = Nothing
    '查询班级信息
    SQL = "SELECT * FROM 班级信息表 ORDER BY 班级名称"
    Set rs = SelectSQL(SQL, msg)
    ListView1.ListItems.Clear    '清空ListView
    If rs.RecordCount = 0 Then   '如果不存在记录
        '编辑控件可用性
        CmdAdd.Enabled = True: CmdModify.Enabled = False: CmdDelete.Enabled = False
        CmdCancel.Enabled = False: CmdSave.Enabled = False
    Else
        rs.MoveFirst
        Do Until rs.EOF
            key = rs.Fields("班级名称")
            Set list = ListView1.ListItems.Add(, , key, 1)
            rs.MoveNext
        Loop
        rs.MoveFirst                 '返回到第一条记录
        '编辑控件可用性
        CmdAdd.Enabled = True: CmdModify.Enabled = True: CmdDelete.Enabled = True
        CmdCancel.Enabled = False: CmdSave.Enabled = False
    End If
    '设置控件Enable值
    Call ControlEnable(False)
End Sub
Private Sub ControlEnable(flag As Boolean)
'设置控件的Enable值
    For index = 0 To 3
        txt(index).Enabled = flag
    Next index
End Sub
Private Sub ShowData()
'在控件中显示数据
    If rs.RecordCount <> 0 Then                     '如果存在记录
        '为控件赋值
        txt(0).Text = rs.Fields("班级名称")
        txt(1).Text = rs.Fields("班级人数")
        txt(2).Text = rs.Fields("所在教室")
        txt(3).Text = rs.Fields("班主任")
    End If
End Sub
Private Sub ListView1_Click()
'在控件中显示班级信息
    Dim key As String
    If rs.RecordCount > 0 Then
        key = Trim(ListView1.SelectedItem)
        SQL = " SELECT * FROM 班级信息表 WHERE 班级名称='" & key & "'"
        Set rs = SelectSQL(SQL, msg)
        Call ShowData                    '重新显示数据
    End If
End Sub
Private Sub CmdAdd_Click()
'添加操作
    '所有控件重置
    Call ControlClear
    '设置控件Enable值为可用
    Call ControlEnable(True)
    '设置标志flag，表示所进行的操作为添加
    flag = "Add"
    '添加、修改、删除按钮不可用，取消、保存按钮可用
    CmdAdd.Enabled = False: CmdModify.Enabled = False: CmdDelete.Enabled = False
    CmdCancel.Enabled = True: CmdSave.Enabled = True
End Sub
Private Sub ControlClear()
'重置控件
    For index = 0 To 3
        Me.txt(index).Text = ""
    Next index
End Sub
Private Sub CmdModify_Click()
'修改操作
    If rs.RecordCount > 0 Then          '如果存在记录
        '设置控件Enable值
        Call ControlEnable(True)
         '班级名称不可以修改,其他控件可用
        txt(0).Enabled = False
        '设置标志flag，表示所进行的操作为修改
        flag = "Modify"
        '添加、修改、删除按钮不可用，取消、保存按钮可用
        CmdAdd.Enabled = False: CmdModify.Enabled = False: CmdDelete.Enabled = False
        CmdCancel.Enabled = True: CmdSave.Enabled = True
    Else
         MsgBox ("没有可以修改的数据!")
    End If
End Sub
Private Sub CmdDelete_Click()
'删除操作
On Error GoTo ErrMsg                '错误处理
    If rs.RecordCount > 0 Then
        msg = MsgBox("删除该条记录吗?", vbYesNo)
        If msg = vbYes Then
            rs.Delete               '删除数据
            '清空控件
            Call ControlClear
            Call LoadData           '重新装载数据
            Call ShowData           '显示数据
            '设置控件Enable值为不可用
            Call ControlEnable(False)
            '添加、修改、删除按钮可用，取消、保存按钮不可用
            CmdAdd.Enabled = True: CmdModify.Enabled = True: 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 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                        '更新数据
    '设置控件的可用性
    CmdModify.Enabled = True: CmdDelete.Enabled = True: CmdAdd.Enabled = True
    CmdSave.Enabled = False: CmdCancel.Enabled = False
    If flag = "Add" Then
        MsgBox ("成功添加数据！")
    Else
        MsgBox ("成功更新数据!")
    End If
    Call LoadData                       '重新装载数据
    '定位到添加或修改记录
    If rs.RecordCount > 0 Then
        rs.MoveFirst
        rs.Find ("班级名称='" & Trim(Me.txt(0).Text) & "'")
        If Not rs.EOF Then Call ShowData                    '重新显示数据
    End If
    Exit Sub
ErrMsg:                              '报告出错信息
    MsgBox Err.Description, vbExclamation, "出错"
End Sub
Private Function CheckData() As Boolean
'检查数据的合法性
    Dim rst As ADODB.Recordset
    Dim msgt As String
    msgt = ""
    '检查数据
    If Trim(txt(0).Text) = "" Then                  '检查班级名称是否为空
        msgt = "班级名称为空； "
        '光标定位
        txt(0).SetFocus
        txt(0).SelStart = 0
        txt(0).SelLength = Len(txt(0).Text)
    ElseIf Not IsNumeric(Me.txt(1).Text) Then       '检查班级人数是否为数字
        msgt = msgt & "班级人数输入不合法； "
        txt(1).Text = 0
    ElseIf Trim(txt(2).Text) = "" Then              '检查所在教室是否为空
        msgt = msgt & "所在教室为空； "
        '光标定位
        txt(2).SetFocus
        txt(2).SelStart = 0
        txt(2).SelLength = Len(txt(2).Text)
    End If
    
    If Not msgt = "" Then                           '如果不为空，给出错误提示
        MsgBox (msgt)
        CheckData = False                           '返回False
        Exit Function
    End If
    '检查唯一性
    SQL = " select * from 班级信息表 where 班级名称='" & Trim(txt(0).Text) & "'"
    Set rst = SelectSQL(SQL, msg)
    '如果是进行添加操作且已经存在该记录，提示重复添加
    If flag = "Add" And rst.RecordCount > 0 Then
        MsgBox ("该信息已经存在，重复添加!")
        '光标定位
        txt(0).SetFocus
        txt(0).SelStart = 0
        txt(0).SelLength = Len(txt(0).Text)
        rst.Close
        CheckData = False                           '返回False
        Exit Function
    End If
    CheckData = True                                '合法返回True
End Function
Private Sub setData()
'为字段设置数据
    rs.Fields("班级名称") = Me.txt(0).Text
    rs.Fields("班级人数") = Me.txt(1).Text
    rs.Fields("所在教室") = Me.txt(2).Text
    rs.Fields("班主任") = Me.txt(3).Text
End Sub
Private Sub cmdCancel_Click()
'取消操作
    Call ShowData                       '重新在控件中显示信息
    '设置控件Enable值为不可用
    Call ControlEnable(False)
    '修改、删除、添加按钮可用,保存和取消按钮不可用
    CmdAdd.Enabled = True: CmdModify.Enabled = True: CmdDelete.Enabled = True
    CmdSave.Enabled = False: CmdCancel.Enabled = False
End Sub
Private Sub CmdExit_Click()
'退出操作
    排课系统.Enabled = True
    Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
'退出操作
    排课系统.Enabled = True
    rs.Close
    Unload Me
End Sub