frmscore.frm

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

        MsflxStuInfo.RemoveItem MsflxStuInfo.Rows - 1
    Loop
    MsflxStuInfo.Row = 1
    For intIndex = 0 To 4
        MsflxStuInfo.Col = intIndex
        MsflxStuInfo.Text = ""
    Next intIndex
    
    If Fun_Rst("studentinfo") Then
        If Rst.BOF = True And Rst.EOF = True Then
            cmdNewScore.Enabled = False             '无记录时则使四个按扭都失效
            cmdDelScore.Enabled = False
            cmdSaveScore.Enabled = False
            cmdNewScore.Enabled = False
            
            Do While MsflxScore.Rows > 3    '无记录时清空MsflxScore
                MsflxScore.RemoveItem MsflxScore.Rows - 1
            Loop
            MsflxScore.Row = 2
            For intIndex = 0 To 6
                MsflxScore.Col = intIndex
                MsflxScore.Text = ""
            Next intIndex
            
            MsgBox "没有任何记录....", vbInformation + vbOKOnly, "信息检索"
        Else
            Do While Rst.EOF = False
                MsflxStuInfo.Row = MsflxStuInfo.Rows - 1
                MsflxStuInfo.Col = 0
                MsflxStuInfo.Text = MsflxStuInfo.Row   '序号
                MsflxStuInfo.Col = 1
                MsflxStuInfo.Text = Rst.Fields("StudentNo") '学号
                MsflxStuInfo.Col = 2
                MsflxStuInfo.Text = Rst.Fields("name")  '姓名
                MsflxStuInfo.Col = 3
                MsflxStuInfo.Text = Rst.Fields("ClassNo")   '班级
                MsflxStuInfo.Col = 4
                MsflxStuInfo.Text = Rst.Fields("Status")
                Rst.MoveNext
                If Rst.EOF = False Then
                    MsflxStuInfo.AddItem Empty
                End If
            Loop
            MsflxStuInfo.Row = 1
            Call MSFlxStuInfo_Click
            MsgBox "信息检索成功....", vbInformation + vbOKOnly, "信息检索"
            
            cmdNewScore.Enabled = True          '有记录存在则使两个按扭生效
            cmdDelScore.Enabled = True
            cmdSaveScore.Enabled = True
        End If
    Else
        MsgBox "信息检索失败....", vbCritical + vbOKOnly, "信息检索"
    End If
    
   ' MsflxStuInfo.Row = 1
    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 cmdSaveScore_Click()
    If IfSave = False Then
        If MsgBox("是否保存当前成绩？", vbInformation + vbYesNo, "保存信息") = vbYes Then
            Call cmdAddScore_Click       '保存当前班级信息
        Else
            IfSave = False
            FraScore.Enabled = False
        End If
    End If
    
    Dim intIndex As Integer
On Error GoTo Err_Rst
 '   MsflxScore.Row = 2
 '   MsflxScore.Col = 1
    MsflxStuInfo.Col = 1
    If Not (Rst.EOF = True And Rst.BOF = True) Then
        Rst.MoveFirst
    End If
    MsflxScore.Row = 2
    MsflxScore.Col = 1
    Do While Rst.EOF = False
        If Rst.Fields("studentno") = MsflxStuInfo.Text Then
            Rst.Delete
            Rst.Update
        End If
        If Rst.EOF = False Then
            Rst.MoveNext
        Else
            Exit Do
        End If
    Loop
    
    '写入数据到数据库
    MsflxScore.Row = 2
    MsflxScore.Col = 1
    If MsflxScore.Text <> "" Then        '如果第一行不存在数据则说明该学生无考试记录,退出
        For intIndex = 2 To MsflxScore.Rows - 1
            Rst.AddNew
            MsflxScore.Row = intIndex
            MsflxScore.Col = 1
                Rst.Fields("studentno") = MsflxScore.Text
            MsflxScore.Col = 2
                Rst.Fields("coursename") = MsflxScore.Text
            MsflxScore.Col = 3
                Rst.Fields("Teacher") = MsflxScore.Text
            MsflxScore.Col = 4
                Rst.Fields("score") = MsflxScore.Text
            MsflxScore.Col = 5
                Rst.Fields("examdate") = MsflxScore.Text
            MsflxScore.Col = 6
                Rst.Fields("remark") = MsflxScore.Text
            Rst.Update
            Rst.MoveNext
        Next intIndex
    End If
    cmdSaveScore.Enabled = False
    IfChanger = False
    MsgBox "数据保存成功", vbInformation + vbOKOnly, "保存"
    Exit Sub
Err_Rst:
    MsgBox "错误描述:" & Err.Description & vbCrLf & "错误代号:" & Err.Number, vbCritical + vbOKOnly, "未知错误"
End Sub



Private Sub Form_Load()
    Dim intIndex As Integer
    IfSave = True
    MsflxStuInfo.ColWidth(0) = 600                '设定第一列宽为600
    MsflxStuInfo.Row = 0        '初始化第一个列表
    MsflxStuInfo.Col = 0
    MsflxStuInfo.Text = "序号"
    
    MsflxStuInfo.Col = 1
    MsflxStuInfo.Text = "学号"
    MsflxStuInfo.ColWidth(1) = 1200
    MsflxStuInfo.Col = 2
    MsflxStuInfo.Text = "姓名"
    MsflxStuInfo.ColWidth(2) = 1200
    MsflxStuInfo.Col = 3
    MsflxStuInfo.Text = "班级"
    MsflxStuInfo.ColWidth(3) = 1200
    MsflxStuInfo.Col = 4
    MsflxStuInfo.Text = "状态"
    MsflxStuInfo.ColWidth(4) = 1200
    MsflxStuInfo.Row = 1
    
    MsflxScore.MergeCells = flexMergeFree
    MsflxScore.Row = 0
    MsflxScore.ColWidth(0) = 600                '设定第一列宽为600
    For intIndex = 1 To MsflxScore.Cols - 1     '初始化第二个列表
        MsflxScore.Col = intIndex
        MsflxScore.Text = "学员成绩信息列表"
        MsflxScore.ColWidth(intIndex) = 1200

    Next intIndex
    MsflxScore.MergeRow(0) = True
    
    MsflxScore.Row = 1
    MsflxScore.Col = 0
    MsflxScore.Text = "序号"
    
    MsflxScore.Col = 1
    MsflxScore.Text = "学号"

    MsflxScore.Col = 2
    MsflxScore.Text = "课程名称"

    MsflxScore.Col = 3
    MsflxScore.Text = "任课老师"
    
    MsflxScore.Col = 4
    MsflxScore.Text = "成绩"
    
    MsflxScore.Col = 5
    MsflxScore.Text = "考试日期"
    
    MsflxScore.Col = 6
    MsflxScore.Text = "备注"
    
    Set Rst = Nothing           '清空记录集
    Fun_Rst ("classinfo")
    Do While Rst.EOF = False                    '从CLASSINFO表中读出所有班级信息
        cmbClass.AddItem Rst.Fields("classNo")
        Rst.MoveNext
    Loop
    cmbClass.ListIndex = 0  '为班级设一个默认值
    
End Sub

Sub DisplayInfo()
    MsflxScore.Col = 1
    txtStudentNo = MsflxScore.Text
    MsflxScore.Col = 2
    txtCourse = MsflxScore.Text
    MsflxScore.Col = 3
    txtTeacher = MsflxScore.Text
    MsflxScore.Col = 4
    txtScore = MsflxScore.Text
    MsflxScore.Col = 5
    txtExamDate = MsflxScore.Text
    MsflxScore.Col = 6
    txtRemark = MsflxScore.Text
    
    Dim intCol As Integer
    Dim intRow As Integer
    Dim TmpRow As Integer
    TmpRow = MsflxScore.Row
    For intRow = 2 To MsflxScore.Rows - 1
        MsflxScore.Row = intRow
        If TmpRow = intRow Then
            For intCol = 1 To MsflxScore.Cols - 1
                MsflxScore.Col = intCol
                MsflxScore.CellForeColor = vbYellow
                MsflxScore.CellBackColor = &H8000000D
            Next intCol
        Else
            For intCol = 1 To MsflxScore.Cols - 1
                MsflxScore.Col = intCol
                MsflxScore.CellBackColor = vbWhite
                MsflxScore.CellForeColor = vbBlack
            Next intCol
        End If
    Next intRow
    MsflxScore.Row = TmpRow
End Sub

Private Sub MsflxScore_Click()
    If IfSave = False Then
        If MsgBox("是否保存当前班级信息？", vbInformation + vbYesNo, "保存信息") = vbYes Then
            Call cmdAddScore_Click       '保存当前班级信息
        Else
            IfSave = False
            FraScore.Enabled = False
        End If
    Else
        Call DisplayInfo
    End If
End Sub

Private Sub MSFlxStuInfo_Click()
    Dim intIndex As Integer
On Error GoTo Err_User

    If IfSave = False Then              '若前面有未保存的信息，则提示
        If MsgBox("是否保存当前班级信息？", vbInformation + vbYesNo, "保存信息") = vbYes Then
            Call cmdAddScore_Click       '保存当前班级信息
        Else
            IfSave = True
            FraScore.Enabled = False
        End If
    End If
    
    Dim intCol As Integer           '界面风格，突出显示当前记录
    Dim intRow As Integer
    Dim TmpRow As Integer
    'MsflxStuInfo.Row = 1
    TmpRow = MsflxStuInfo.Row
    For intRow = 1 To MsflxStuInfo.Rows - 1
        MsflxStuInfo.Row = intRow
        If TmpRow = intRow Then
            For intCol = 1 To MsflxStuInfo.Cols - 1
                MsflxStuInfo.Col = intCol
                MsflxStuInfo.CellForeColor = vbYellow
                MsflxStuInfo.CellBackColor = &H8000000D
            Next intCol
        Else
            For intCol = 1 To MsflxStuInfo.Cols - 1
                MsflxStuInfo.Col = intCol
                MsflxStuInfo.CellBackColor = vbWhite
                MsflxStuInfo.CellForeColor = vbBlack
            Next intCol
        End If
    Next intRow
    MsflxStuInfo.Row = TmpRow
    Rst.Filter = adFilterNone
    
    Do While MsflxScore.Rows > 3        '清空MsflxScore
        MsflxScore.RemoveItem MsflxScore.Rows - 1
    Loop
    MsflxScore.Row = 2
    For intIndex = 0 To 6
        MsflxScore.Col = intIndex
        MsflxScore.Text = ""
    Next intIndex
    
    Set Rst = New ADODB.Recordset
    Fun_Rst ("scoreinfo")   '打开记录集
    MsflxStuInfo.Col = 1
    Rst.Filter = ("studentno='" & MsflxStuInfo.Text & "'")
    Do While Rst.EOF = False
        MsflxScore.Row = MsflxScore.Rows - 1
        MsflxScore.Col = 0
        MsflxScore.Text = MsflxScore.Rows - 2
        MsflxScore.Col = 1
        MsflxScore.Text = Rst.Fields("studentNo")
        MsflxScore.Col = 2
        MsflxScore.Text = Rst.Fields("courseName")
        MsflxScore.Col = 3
        MsflxScore.Text = Rst.Fields("Teacher")
        MsflxScore.Col = 4
        MsflxScore.Text = Rst.Fields("score")
        MsflxScore.Col = 5
        MsflxScore.Text = Rst.Fields("examDate")
        MsflxScore.Col = 6
        MsflxScore.Text = Rst.Fields("remark")
        Rst.MoveNext
        If Rst.EOF = False Then
            MsflxScore.AddItem Empty
        End If
    Loop
    MsflxScore.Row = 2                          '缺省情况下当前记录为第一条
            For intIndex = 1 To MsflxScore.Cols - 1
                MsflxScore.Col = intIndex
                MsflxScore.CellForeColor = vbYellow
                MsflxScore.CellBackColor = &H8000000D
            Next intIndex
    Exit Sub
Err_User:
    If Err.Number = 94 Then
        Resume Next
    Else
        MsgBox "错误描述:" & Err.Description & vbCrLf & "错误代号:" & Err.Number, vbCritical + vbOKOnly, "未知错误"
    End If
End Sub

Private Sub txtExamDate_LostFocus()
On Error GoTo Err_Date
    If txtExamDate <> Empty Then
        txtExamDate = CDate(txtExamDate)
    End If
    Exit Sub
Err_Date:
    MsgBox "日期格式错误", vbCritical + vbOKOnly, "错误"
    txtExamDate = Empty
End Sub
Private Sub cmdLast_Click()
    MsflxScore.Row = MsflxScore.Rows - 1
    DisplayInfo
End Sub

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

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

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