frmteacher.frm

所在类别： 随书资源/T 工业技术/TP 自动化技术、计算机技术/TP31 计算机软件 其他题名： 作者： 夏邦贵, 刘凡馨等编著 出版者： 机械工业出版社 出版年： 2006 I

        .CursorLocation = adUseClient           '指定使用客户端游标
        .CursorType = adOpenStatic              '指定使用静态游标
        .LockType = adLockOptimistic
        .Open "SELECT * FROM 系部信息"          '获取系部信息记录
    End With
    '建立系部名称列表
    cmbDepart.AddItem ""                        '添加一个空的列表项
    With objDepart
        If .RecordCount > 0 Then
            .MoveFirst
            While Not .EOF
                cmbDepart.AddItem .Fields("名称")
                .MoveNext
            Wend
        End If
    End With
    '触发按钮单击事件，显示第一个记录
    cmdMove(0).Value = True
End Sub

Private Sub cmdMove_Click(Index As Integer)
    With objTeacher
        Select Case Index           '切换当前记录
            Case 0                  '使第一个记录成为当前记录
                If .RecordCount > 0 And Not .BOF Then .MoveFirst
            Case 1                  '使上一个记录成为当前记录
                If .RecordCount > 0 And Not .BOF Then
                    .MovePrevious
                    If .BOF Then .MoveFirst
                End If
            Case 2                  '使下一个记录成为当前记录
                If .RecordCount > 0 And Not .EOF Then
                    .MoveNext
                    If .EOF Then .MoveLast
                End If
            Case 3                  '使最后一个记录成为当前记录
                If .RecordCount > 0 And Not .EOF Then .MoveLast
        End Select
        If .RecordCount < 1 Then
            txtNews = "记录：无"    '显示无记录提示
            txtNum = ""
            txtName = ""
            txtPhone = ""
            txtEmail = ""
            cmbDepart.ListIndex = 0
        Else
            '显示当前记录数据
            ShowData
        End If
    End With
    If isAdding Then isAdding = False
End Sub

Private Sub cmdAdd_Click()
    txtNews = "添加新记录"
    txtNum = ""
    txtName = ""
    txtPhone = ""
    txtEmail = ""
    cmbDepart.ListIndex = 1
    isAdding = True
End Sub

Private Sub cmdDelete_Click()
    '根据是否处于添加记录状态执行不同的操作
    If isAdding Then
        '退出添加记录状态，显示当前记录
        isAdding = False
        If objTeacher.RecordCount < 1 Then
            txtNews = "记录：无"    '显示无记录提示
            '清空各个控件
            txtNum = ""
            txtName = ""
            txtPhone = ""
            txtEmail = ""
            cmbDepart.ListIndex = 0
        Else
            '显示当前记录数据
            ShowData
        End If
    Else
        If objTeacher.RecordCount > 0 Then
            '检查在课程信息表中是否使用了当前记录的编号
            '如果被使用，则不执行删除操作
            Dim objTemp As New Recordset
            With objTemp
                Set .ActiveConnection = objCn           '设置数据库联接
                .CursorLocation = adUseClient           '指定使用客户端游标
                .CursorType = adOpenStatic              '指定使用静态游标
                '获取使用了该编号的第一条记录
                .Open "SELECT TOP 1 * FROM 课程信息 WHERE 教师='" & Trim(txtNum) & "'"
                If .RecordCount > 0 Then
                    MsgBox "编号被《课程信息》表使用，不能删除当前记录！", vbInformation, "教师信息管理"
                    Exit Sub
                End If
                .Close
            End With
            Set objTemp = Nothing
            '可以删除，请求确认执行删除操作
            If MsgBox("是否删除当前记录？", vbYesNo + vbQuestion, "教师信息管理") = vbYes Then
                '执行删除当前记录操作
                objTeacher.Delete
                '显示下一记录数据
                cmdMove(2).Value = True
            Else
                '显示当前记录数据
                ShowData
            End If
        End If
    End If
End Sub
Private Sub cmdSave_Click()
    '在当前表中无数据和不是添加记录时，不执行保存操作
    If Not isAdding And objTeacher.RecordCount < 1 Then Exit Sub
    '获得当前记录数据
    Dim strNum$, strName$, strPhone$, strEmail$, strDepart$
    strNum = Trim(txtNum)
    strName = Trim(txtName)
    strPhone = Trim(txtPhone)
    strEmail = Trim(txtEmail)
    '根据系名称获得系编号
    If cmbDepart <> "" Then
        objDepart.MoveFirst
        objDepart.Find "名称='" & cmbDepart & "'"
        strDepart = objDepart.Fields("编号")
    End If
    '检验是否输入教师编号
    If Len(strNum) <> 6 Then
        MsgBox "教师编号必须为6位字符串！", vbCritical, "教师信息管理"
        txtNum.SetFocus
        txtNum.SelStart = 0
        txtNum.SelLength = Len(txtNum)
        Exit Sub
    End If
    '检验是否输入教师姓名
    If Trim(txtName) = "" Then
        MsgBox "教师名称不能为空！", vbCritical, "教师信息管理"
        txtName.SetFocus
        txtName = ""
        Exit Sub
    End If
    '检验选择了所属系部
    If cmbDepart = "" Then
        MsgBox "必须指定所属系部！", vbCritical, "教师信息管理"
        cmbDepart.SetFocus
        Exit Sub
    End If
     '检验指定的Email地址是否有效
    If InStr(strEmail, "@") = 0 Then
        MsgBox "电子邮件地址无效！", vbCritical, "教师信息管理"
        txtEmail.SetFocus
        txtEmail.SelStart = 0
        txtEmail.SelLength = Len(txtEmail)
        Exit Sub
    End If
    '检查是否修改了当前记录
    If objTeacher.RecordCount > 0 Then
        If Not isAdding And objTeacher.Fields("编号") = strNum _
            And objTeacher.Fields("姓名") = strName _
            And objTeacher.Fields("系编号") = strDepart _
            And objTeacher.Fields("电话") = strPhone _
            And objTeacher.Fields("Email") = strEmail Then
            '没有修改当前记录，不需执行保存操作，直接退出过程
            Exit Sub
        End If
    End If
    '在进一步保存添加的新记录或修改的当前记录之前，检查编号是否重复
    Dim objCopy As New Recordset
    Set objCopy = objTeacher.Clone
    If objCopy.RecordCount > 0 Then
        objCopy.MoveFirst
        objCopy.Find "编号='" & strNum & "'"
        If (isAdding And Not objCopy.EOF) Or (Not isAdding And Not objCopy.EOF And _
            objCopy.AbsolutePosition <> objTeacher.AbsolutePosition) Then
            MsgBox "编号：" & strNum & "已被使用，请使用其他编号！", _
            vbCritical, "教师信息管理"
            txtNum.SetFocus
            txtNum.SelStart = 0
            txtNum.SelLength = Len(txtNum)
            Exit Sub        '编号重复，直接退出
        End If
    End If
    '编号不重复，执行下一步保存操作
    With objTeacher
        If isAdding Then
            '添加新记录
            .AddNew
        Else
            '保存被修改的当前记录
            If .Fields("编号") <> strNum Then
                If MsgBox("修改编号将影响《课程信息》表中的相关记录，是否继续？", _
                   vbYesNo + vbQuestion, "教师信息管理") = vbNo Then
                    '取消修改，还原当前记录
                    ShowData
                    Exit Sub
                End If
            End If
        End If
        '修改记录
        .Fields("编号") = strNum
        .Fields("姓名") = strName
        .Fields("系编号") = strDepart
        .Fields("电话") = strPhone
        .Fields("Email") = strEmail
        '执行更新操作
        .Update
        MsgBox "数据保存成功！", vbInformation, "教师信息管理"
        isAdding = False
        '显示当前记录编号和记录总数
        txtNews = "记录：" & .AbsolutePosition & "/" & .RecordCount
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    objCn.Close                 '关闭数据联接
    Set objCn = Nothing         '释放数据库联接
    Set objTeacher = Nothing     '释放记录集对象
    Set objDepart = Nothing     '释放记录集对象
End Sub

'限制编号输入
Private Sub txtNum_KeyPress(KeyAscii As Integer)
    If Not (Chr(KeyAscii) Like "[0-9]" Or Chr(KeyAscii) Like "[a-z]" _
           Or Chr(KeyAscii) Like "[A-Z]" Or KeyAscii = vbKeyBack) Then
        KeyAscii = 0    '输入不是数字、英文字母或退格键，取消输入
    End If
    '将小写字母转换为大写
    If Chr(KeyAscii) Like "[a-z]" Then
        KeyAscii = KeyAscii - 32  '输入不是数字、英文字母或退格键，取消输入
    End If
End Sub

'显示objTeacher当前记录信息
Private Sub ShowData()
    With objTeacher
        '显示当前记录数据
        txtName = .Fields("姓名")
        txtNum = .Fields("编号")
        If IsNull(.Fields("电话")) Then
            txtPhone = "无"
        Else
            txtPhone = .Fields("电话")
        End If
        If IsNull(.Fields("Email")) Then
            txtEmail = "无"
        Else
            txtEmail = .Fields("Email")
        End If
        '根据系编号显示系名称
        objDepart.MoveFirst
        objDepart.Find "编号='" & .Fields("系编号") & "'"
        cmbDepart.ListIndex = objDepart.AbsolutePosition
        '显示当前记录编号和记录总数
        txtNews = "记录：" & objTeacher.AbsolutePosition & "/" _
                  & objTeacher.RecordCount
    End With
End Sub

Private Sub txtPhone_KeyPress(KeyAscii As Integer)
 If Not (Chr(KeyAscii) Like "[0-9]" Or KeyAscii = vbKeyBack) Then
        KeyAscii = 0    '输入不是数字或退格键，取消输入
    End If
End Sub