frmclassg.frm

北大青鸟教学管理系统是学习规范编程范本.功能非常完备,代码编写有章法,不可多得

        MsgBox "至少要有一条记录存在", vbCritical + vbOKOnly, "删除错误"
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
End Sub

Private Sub cmdModi_Click()
    cmdAdd.Enabled = True       '使保存班级生效
    If IfSave = False Then
        If MsgBox("是否保存当前班级信息？", vbInformation + vbYesNo, "保存信息") = vbYes Then
            
            Call cmdAdd_Click       '保存当前班级信息
        End If
    End If
    If IfSave = True Then
        fraClassInfo.Enabled = True
        txtClassNo.Enabled = False
    End If
End Sub

Private Sub cmdNew_Click()
    cmdAdd.Enabled = True   '使保存班级生效
    If IfSave = False Then
        If MsgBox("是否保存当前班级信息？", vbInformation + vbYesNo, "保存信息") = vbYes Then
            Call cmdAdd_Click       '保存当前班级信息
        End If
    ElseIf IfAdd = True Then
        'MsflxClass.RemoveItem MsflxClass.Rows - 1
    End If
    If IfSave = True Then
        IfSave = False  '声明信息未保存
        IfAdd = True
        MsflxClass.Row = MsflxClass.Rows - 1
        MsflxClass.Col = 1
        If MsflxClass.Text <> "" Then       '当最后一行不为空时才增行
            MsflxClass.AddItem Empty
        End If
        MsflxClass.Row = MsflxClass.Rows - 1
        MsflxClass.Col = 0
        MsflxClass.Text = MsflxClass.Rows - 2
        fraClassInfo.Enabled = True
        txtClassNo.Enabled = True       '清空各个控件
        txtClassNo = Empty
        txtBegDate = Empty
        txtEndDate = Empty
        txtRemark = Empty
    End If
End Sub

Private Sub cmdQuit_Click()
    Unload Me
End Sub

Private Sub cmdRetrieve_Click()
On Error GoTo ErrLab
    Dim intIndex As Integer
    cmdDelete.Enabled = True    '按下检索后使各个按扭生效
    cmdNew.Enabled = True
    cmdModi.Enabled = True
    cmdPrevious.Enabled = True
    cmdFirst.Enabled = True
    cmdNext.Enabled = True
    cmdLast.Enabled = True
    
    Do While MsflxClass.Rows > 3   '以下8行为清空列表
        MsflxClass.RemoveItem MsflxClass.Rows - 1
    Loop
    MsflxClass.Row = 2
    For intIndex = 0 To 4
        MsflxClass.Col = intIndex
        MsflxClass.Text = Empty
    Next intIndex
    
    Set Rst = New ADODB.Recordset
    If Fun_Rst("classinfo") Then
        
        If Rst.BOF = True And Rst.EOF = True Then
            MsgBox "没有任何记录....", vbInformation + vbOKOnly, "检索记录"
        Else
            Do While Rst.EOF = False
                MsflxClass.Row = MsflxClass.Rows - 1
                MsflxClass.Col = 0
                MsflxClass.Text = MsflxClass.Rows - 2   '序号
                MsflxClass.Col = 1
                MsflxClass.Text = Rst.Fields("ClassNo") '班级编号
                MsflxClass.Col = 2
                MsflxClass.Text = Rst.Fields("begdate") '开学日期
                MsflxClass.Col = 3
                If Rst.Fields("enddate") <> Null Then
                    MsflxClass.Text = CStr(Rst.Fields("enddate"))   '结业日期
                Else
                    MsflxClass.Text = Empty
                End If
                MsflxClass.Col = 4
                If Rst.Fields("remark") <> Null Then
                    MsflxClass.Text = Rst.Filter("remark")      '备注
                Else
                    MsflxClass.Text = Empty
                End If
                Rst.MoveNext
                If Rst.EOF = False Then
                    MsflxClass.AddItem Empty
                End If
            Loop
            MsflxClass.Row = 2                          '缺省情况下当前记录为第一条
            Call DisplayInfo
            MsgBox "信息检索成功....", vbInformation + vbOKOnly, "信息检索"
        End If
    Else
        MsgBox "信息检索失败....", vbCritical + vbOKOnly, "信息检索"
    End If
    Exit Sub
ErrLab:
    If Err.Number = 94 Then
        Resume Next
    Else
        MsgBox "未知错误:" & Err.Description & vbCrLf & "错误代号:" & Err.Number, vbCritical + vbOKOnly, "未知错误"
    End If
End Sub


Private Sub cmdSave_Click()
On Error GoTo Err
    Dim intIndex As Integer
        If Rst.EOF = True And Rst.BOF = True Then
        Else
            Rst.MoveFirst
        End If
        MsflxClass.Row = MsflxClass.Rows - 1
        MsflxClass.Col = 1
        If MsflxClass.Text <> "" Then
            For intIndex = 2 To MsflxClass.Rows - 1
                MsflxClass.Row = intIndex
                MsflxClass.Col = 1
                Rst.Find "classno='" & MsflxClass.Text & "'", , adSearchForward     '查找记录集中是否已有此记录
                If Rst.EOF = True Then
                    Rst.AddNew
                End If
                Rst.Fields("ClassNo") = MsflxClass.Text
                MsflxClass.Col = 2
                Rst.Fields("BegDate") = MsflxClass.Text
                MsflxClass.Col = 3
                If MsflxClass.Text <> "" Then
                    Rst.Fields("EndDate") = MsflxClass.Text
                End If
                MsflxClass.Col = 4
                If MsflxClass.Text <> "" Then
                    Rst.Fields("remark") = MsflxClass.Text
                End If
                Rst.Update
                Rst.MoveNext
        
            Next intIndex
        End If
        MsgBox "数据保存成功", vbInformation + vbOKOnly, "保存"
        Unload Me
    Exit Sub
Err:
    MsgBox Err.Number & Err.Description
    Resume Next
End Sub

Private Sub Form_Load()
    Dim intIndex As Integer
    MsflxClass.MergeCells = flexMergeFree
    MsflxClass.Row = 0
    MsflxClass.ColWidth(0) = 600                '设定第一列宽为600
    For intIndex = 1 To MsflxClass.Cols - 1
        MsflxClass.Col = intIndex
        MsflxClass.Text = "班级信息列表"
        MsflxClass.ColWidth(intIndex) = 1400
        
    Next intIndex
    MsflxClass.MergeRow(0) = True
    
    MsflxClass.Row = 1
    MsflxClass.Col = 0
    MsflxClass.Text = "序号"
    
    MsflxClass.Col = 1
    MsflxClass.Text = "班级编号"
    
    MsflxClass.Col = 2
    MsflxClass.Text = "开班日期"

    MsflxClass.Col = 3
    MsflxClass.Text = "结业日期"

    MsflxClass.Col = 4
    MsflxClass.Text = "备注"

    
    Call Pri1.Open("studentinfo", Con, adOpenDynamic, adLockReadOnly)       '用于判断是否被学生基本信息表引用
    Call Pri2.Open("terminfo", Con, adOpenDynamic, adLockReadOnly)
    IfSave = True       '初始化，设无班级信息被更改
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Pri1.Close
    Pri2.Close
    
End Sub

Private Sub MSFlxClass_Click()
    
    If IfSave = False Then
        If MsgBox("是否保存当前班级信息？", vbInformation + vbYesNo, "保存信息") = vbYes Then
            Call cmdAdd_Click       '保存当前班级信息
        Else
            IfSave = True
            MsflxClass.RemoveItem (MsflxClass.Rows - 1)
            fraClassInfo.Enabled = False
            txtClassNo.Enabled = False
            
        End If
    Else
        DisplayInfo
    End If

End Sub

Private Sub txtBegDate_LostFocus()
On Error GoTo Err_Date
    If txtBegDate <> Empty Then
        txtBegDate = CDate(txtBegDate)
    End If
    Exit Sub
Err_Date:
    MsgBox "日期格式错误", vbCritical + vbOKOnly, "错误"
    txtBegDate.SetFocus
    txtBegDate = Empty
End Sub

Private Sub txtEndDate_LostFocus()
On Error GoTo Err_Date
    If txtEndDate <> Empty Then
        txtEndDate = CDate(txtEndDate)
    End If
    Exit Sub
Err_Date:
    MsgBox "日期格式错误", vbCritical + vbOKOnly, "错误"
    txtEndDate.SetFocus
    txtEndDate = Empty
End Sub

Sub DisplayInfo()
    MsflxClass.Col = 1
    txtClassNo = MsflxClass.Text
    MsflxClass.Col = 2
    txtBegDate = MsflxClass.Text
    MsflxClass.Col = 3
    txtEndDate = MsflxClass.Text
    MsflxClass.Col = 4
    txtRemark = MsflxClass.Text
    
    Dim intCol As Integer
    Dim intRow As Integer
    Dim TmpRow As Integer
    TmpRow = MsflxClass.Row
    For intRow = 2 To MsflxClass.Rows - 1
        MsflxClass.Row = intRow
        If TmpRow = intRow Then
            For intCol = 1 To MsflxClass.Cols - 1
                MsflxClass.Col = intCol
                MsflxClass.CellForeColor = vbYellow
                MsflxClass.CellBackColor = &H8000000D
            Next intCol
        Else
            For intCol = 1 To MsflxClass.Cols - 1
                MsflxClass.Col = intCol
                MsflxClass.CellBackColor = vbWhite
                MsflxClass.CellForeColor = vbBlack
            Next intCol
        End If
    Next intRow
    MsflxClass.Row = TmpRow
End Sub

Private Sub cmdLast_Click()
    MsflxClass.Row = MsflxClass.Rows - 1
    DisplayInfo
End Sub

Private Sub cmdNext_Click()
    If MsflxClass.Row < MsflxClass.Rows - 1 Then
        MsflxClass.Row = MsflxClass.Row + 1
        DisplayInfo
    End If
End Sub

Private Sub cmdPrevious_Click()
    If MsflxClass.Row > 2 Then
        MsflxClass.Row = MsflxClass.Row - 1
        DisplayInfo
    End If
End Sub

Private Sub cmdFirst_Click()
    MsflxClass.Row = 2
    DisplayInfo
End Sub