frmtermg.frm

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

        
    Else
       ' MsflxTerm.Row = 2
        MsflxTerm.Col = 1
        If IfNew And MsflxTerm.Text <> "" Then
            MsflxTerm.AddItem Empty
            MsflxTerm.Row = MsflxTerm.Rows - 1          '新增记录
        End If
        MsflxTerm.Col = 0
        MsflxTerm.Text = MsflxTerm.Row - 1
        MsflxTerm.Col = 1
        MsflxTerm.Text = txtTermNo
        MsflxTerm.Col = 2
        MsflxTerm.Text = txtTerm
        MsflxTerm.Col = 3
        MsflxTerm.Text = txtClassCode
        MsflxTerm.Col = 4
        MsflxTerm.Text = txtStartDate
        MsflxTerm.Col = 5
        MsflxTerm.Text = txtEndDate
        MsflxTerm.Col = 6
        MsflxTerm.Text = txtDirector
        MsflxTerm.Col = 7
        MsflxTerm.Text = txtRemark
        IfSave = True                   '声明记录已经保存
        FraClass.Enabled = False        '新增记录后将文本框禁用
        txtTermNo.Enabled = False
        cmdDel.Enabled = True           '使删除和修改按扭生效
        cmdModi.Enabled = True
    End If
End Sub
Private Sub cmdDel_Click()
    Dim intIndex
    If MsflxTerm.Rows > 3 Then
        MsflxTerm.RemoveItem MsflxTerm.Row
    Else
        MsflxTerm.Row = 2
        For intIndex = 0 To MsflxTerm.Cols - 1
            MsflxTerm.Col = intIndex
            MsflxTerm.Text = Empty
        Next intIndex
    End If
End Sub


Private Sub cmdModi_Click()

    FraClass.Enabled = True
    IfSave = False              '声明存在没有保存的记录
    cmdAdd.Enabled = True       '启用保存
    Call DisplayInfo
    
End Sub

Private Sub cmdNew_Click()
    Call Clear_Txt                          '清空文本框
    FraClass.Enabled = True                 '新建时使禁用的按扭生效
    txtTermNo.Enabled = True
    cmdAdd.Enabled = True
    cmdDel.Enabled = False                  '新增记录时不允许删除和修改
    cmdModi.Enabled = False
    IfSave = False                          '声明存在没有保存的记录
    IfNew = True                            '表明按下了新增
End Sub

Sub Clear_Txt()
    txtTermNo = ""
    txtTerm = ""
    txtClassCode = ""
    txtStartDate = Date
    txtEndDate = ""
    txtDirector = ""
    txtRemark = ""
End Sub

Private Sub cmdQuit_Click()
    Unload Me
End Sub

Private Sub cmdSave_Click()
    Dim intIndex As Integer
On Error Resume Next
    
    Rst.MoveFirst
    If Err.Number = 0 Then
        Do While Rst.EOF = False '清空记录集中所有记录
            Rst.Delete
            Rst.Update
            Rst.MoveNext
        Loop
        Err.Clear
    End If
    Rst.AddNew
    For intIndex = 2 To MsflxTerm.Rows - 1
        MsflxTerm.Row = intIndex
        MsflxTerm.Col = 1
        Rst.Fields("termno") = MsflxTerm.Text
        MsflxTerm.Col = 2
        Rst.Fields("term") = MsflxTerm.Text
        MsflxTerm.Col = 3
        Rst.Fields("classno") = MsflxTerm.Text
        MsflxTerm.Col = 4
        Rst.Fields("begdate") = CDate(MsflxTerm.Text)
        MsflxTerm.Col = 5
        If MsflxTerm.Text <> "" Then
        Rst.Fields("enddate") = CDate(MsflxTerm.Text)
        End If
        MsflxTerm.Col = 6
        Rst.Fields("director") = txtEndDate
        MsflxTerm.Col = 7
        If MsflxTerm.Text <> "" Then
            Rst.Fields("remark") = txtRemark
        End If
        Rst.Update
        Rst.MoveNext
        
        If Rst.EOF Then
            Rst.AddNew
        End If
    Next intIndex

    MsgBox "数据保存成功", vbInformation + vbOKOnly, "保存"

End Sub

Private Sub cmdSearch_Click()
    Dim intIndex
    Dim strSearch As String
    On Error GoTo Err_Term
    
    Do While MsflxTerm.Rows > 3   '以下8行为清空列表
        MsflxTerm.RemoveItem MsflxTerm.Rows - 1
    Loop
    MsflxTerm.Row = 2
    For intIndex = 0 To 7
        MsflxTerm.Col = intIndex
        MsflxTerm.Text = Empty
    Next intIndex
    
    cmdPrevious.Enabled = True          '按下检索按扭后启用下列按扭
    cmdFirst.Enabled = True
    cmdNext.Enabled = True
    cmdLast.Enabled = True
    cmdNew.Enabled = True
    cmdDel.Enabled = True
    cmdModi.Enabled = True
    
    Set Rst = Nothing
    Call Fun_Rst("TermInfo")
    
    If Rst.BOF = True And Rst.EOF = True Then
        MsgBox "没有任何记录....", vbInformation + vbOKOnly, "检索记录"
    Else
        Rst.MoveFirst
        Do While Rst.EOF = False                '读取记录

            MsflxTerm.Row = MsflxTerm.Rows - 1
            MsflxTerm.Col = 0
            MsflxTerm.Text = MsflxTerm.Rows - 2   '序号
            MsflxTerm.Col = 1
            MsflxTerm.Text = Rst.Fields("TermNo")
            MsflxTerm.Col = 2
            MsflxTerm.Text = Rst.Fields("Term")
            MsflxTerm.Col = 3
            MsflxTerm.Text = Rst.Fields("ClassNo")
            MsflxTerm.Col = 4
            MsflxTerm.Text = Rst.Fields("Begdate")
            MsflxTerm.Col = 5
            MsflxTerm.Text = Rst.Fields("Enddate")
            MsflxTerm.Col = 6
            MsflxTerm.Text = Rst.Fields("Director")
            MsflxTerm.Col = 7
            If Rst.Fields("remark") <> Null Then
                MsflxTerm.Text = Rst.Fields("remark")
            Else
                  MsflxTerm.Text = Empty
            End If
            Rst.MoveNext
            If Rst.EOF = False Then
                MsflxTerm.AddItem Empty
            End If
        Loop
        MsflxTerm.Row = 2
        Call DisplayInfo
        MsgBox "检索信息成功....", vbInformation + vbOKOnly, "检索记录"
    End If
    Exit Sub
Err_Term:
    If Err.Number = 94 Then
        Resume Next
    Else
        MsgBox "未知错误:" & Err.Description & vbCrLf & "错误代号:" & Err.Number, vbCritical + vbOKOnly, "未知错误"
    End If
End Sub

Private Sub Command1_Click()
    Rst.UpdateBatch
End Sub

Private Sub Form_Load()
    IfSave = True       '初始化为真，假设信息没有改动
    Call InitMsflx
End Sub

Private Sub MsflxTerm_Click()
    If IfSave = False Then
        If MsgBox("是否保存此条记录？", vbInformation + vbYesNo, "保存") = vbYes Then
            Call cmdAdd_Click
        End If
        IfSave = True                   '声明记录已经保存
        FraClass.Enabled = False        '新增记录后将文本框禁用
        txtTermNo.Enabled = False
        cmdDel.Enabled = True           '使删除和修改按扭生效
        cmdModi.Enabled = True
        cmdAdd.Enabled = False      '禁用保存
    End If
    Call DisplayInfo
End Sub
Sub DisplayInfo()
    MsflxTerm.Col = 1
    txtTermNo = MsflxTerm.Text
    MsflxTerm.Col = 2
    txtTerm = MsflxTerm.Text
    MsflxTerm.Col = 3
    txtClassCode = MsflxTerm.Text
    MsflxTerm.Col = 4
    txtStartDate = MsflxTerm.Text
    MsflxTerm.Col = 5
    txtEndDate = MsflxTerm.Text
    MsflxTerm.Col = 6
    txtDirector = MsflxTerm.Text
    MsflxTerm.Col = 7
    txtRemark = MsflxTerm.Text
    
    Dim intCol As Integer
    Dim intRow As Integer
    Dim TmpRow As Integer
    TmpRow = MsflxTerm.Row
    For intRow = 2 To MsflxTerm.Rows - 1
        MsflxTerm.Row = intRow
        If TmpRow = intRow Then
            For intCol = 1 To MsflxTerm.Cols - 1
                MsflxTerm.Col = intCol
                MsflxTerm.CellForeColor = vbYellow
                MsflxTerm.CellBackColor = &H8000000D
            Next intCol
        Else
            For intCol = 1 To MsflxTerm.Cols - 1
                MsflxTerm.Col = intCol
                MsflxTerm.CellBackColor = vbWhite
                MsflxTerm.CellForeColor = vbBlack
            Next intCol
        End If
    Next intRow
    MsflxTerm.Row = TmpRow
End Sub





Private Sub txtEndDate_LostFocus()
On Error GoTo Err
    If txtEndDate <> "" Then
        txtEndDate = CDate(txtEndDate)
    End If
    Exit Sub
Err:
    If Err.Number = 13 Then
        MsgBox "日期格式错误", vbInformation + vbOKOnly, "错误"
        txtEndDate.SetFocus
    Else
        MsgBox "错误描述:" & Err.Description & vbCrLf & "错误代码:" & Err.Number, vbCritical + vbOKOnly, "未知错误"
    End If
End Sub

Private Sub txtStartDate_LostFocus()
    On Error GoTo Err
    If txtStartDate <> "" Then
        txtStartDate = CDate(txtStartDate)
    End If
    Exit Sub
Err:
    If Err.Number = 13 Then
        MsgBox "日期格式错误", vbInformation + vbOKOnly, "错误"
        txtStartDate.SetFocus
    Else
        MsgBox "错误描述:" & Err.Description & vbCrLf & "错误代码:" & Err.Number, vbCritical + vbOKOnly, "未知错误"
    End If
End Sub


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

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

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

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