学生信息.frm

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

End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim isAdding As Boolean             '定义操作状态标志
Dim objStudent As Recordset         '用于保存学生信息记录
Dim objDepart As Recordset          '用于保存系部编号和名称
Dim objGrade As Recordset           '用于保存班级编号和名称
Dim objCn As Connection             '用于建立数据库连接

Private Sub cmdExit_Click()
    Unload Me                       '关闭学生信息管理窗体
End Sub

Private Sub cmdSeek_Click()
   Dim strKey$, intCurrent%
    strKey = InputBox("请输入要查询的学生姓名或开头字符！", "查询学生")
    If strKey = "" Then
        MsgBox "输入无效！", vbInformation, "学生信息管理"
    Else
        With objStudent
            intCurrent = .AbsolutePosition     '保存当前记录位置
            If .RecordCount > 0 Then
                .MoveFirst
                .Find "姓名 like '" & strKey & "*'"
                If .EOF Then
                    MsgBox "无姓名为 " & strKey & " 的学生信息记录！"
                    '恢复当前记录为执行查找操作前的记录
                    .MoveFirst
                    .Move intCurrent - 1
                Else
                    ShowData        '显示符合条件的第一条记录数据
                End If
            Else
                MsgBox "学生信息记录！", vbInformation, "学生信息管理"
            End If
        End With
    End If
End Sub

Private Sub Form_Load()
    Set objCn = New Connection                 '实例化连接对象
    With objCn                                 '建立数据库连接
        .Provider = "SQLOLEDB"
        .ConnectionString = "User ID=sa;PWD=123;Data Source=(local);" & _
                            "Initial Catalog=学分制选课"
        .Open                                    '建立数据库连接
    End With
    '获取学生信息记录
    Set objStudent = New Recordset              '实例化objStudent对象
    With objStudent
        Set .ActiveConnection = objCn           '设置数据库连接
        .CursorLocation = adUseClient           '指定使用客户端游标
        .CursorType = adOpenStatic             '指定使用静态游标
        .LockType = adLockBatchOptimistic
        .Open "SELECT * FROM 学生信息"          '获取学生信息记录
        Set .ActiveConnection = Nothing
    End With
    '获取系部编号和名称，建立系部名称列表
    Set objDepart = New Recordset               '实例化objDepart对象
    With objDepart
        Set .ActiveConnection = objCn           '设置数据库连接
        .CursorLocation = adUseClient           '指定使用客户端游标
        .CursorType = adOpenStatic              '指定使用静态游标
        .Open "SELECT 编号,名称 FROM 系部信息"  '获取系部编号和名称
        Set .ActiveConnection = Nothing
        cmbDepart.AddItem ""                    '添加一个空的列表项
        If .RecordCount > 0 Then
            .MoveFirst
            While Not .EOF
                cmbDepart.AddItem .Fields!名称
                .MoveNext
            Wend
        End If
    End With
    '获取班级编号和名称，建立班级名称列表
    Set objGrade = New Recordset               '实例化objGrade对象
    With objGrade
        Set .ActiveConnection = objCn           '设置数据库连接
        .CursorLocation = adUseClient           '指定使用客户端游标
        .CursorType = adOpenStatic              '指定使用静态游标
        .Open "SELECT 编号,名称 FROM 班级信息"  '获取班级编号和名称
        Set .ActiveConnection = Nothing
        cmbGrade.AddItem ""                     '添加一个空的列表项
        If .RecordCount > 0 Then
            .MoveFirst
            While Not .EOF
                cmbGrade.AddItem .Fields("名称")
                .MoveNext
            Wend
        End If
    End With
    cmdMove(0).Value = True                 '触发按钮单击事件，显示第一个记录
    objCn.Close
End Sub

Private Sub cmdMove_Click(Index As Integer)
    With objStudent
        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 = ""
            txtHome = "":   txtExp = ""
            txtBirth = ""
            cmbDepart.ListIndex = 0
            cmbGrade.ListIndex = 0
        Else
            ShowData '显示当前记录数据
        End If
    End With
    '改变当前记录则退出当前添加记录状态
    If isAdding Then isAdding = False
End Sub

Private Sub cmdAdd_Click()
    txtNews = "添加新记录"
    txtNum = Trim(Str(Year(Date))) + "0001"
    txtName = ""
    txtPhone = ""
    txtEmail = ""
    txtHome = ""
    txtExp = ""
    txtBirth = "2000-01-01"
    cmbDepart.ListIndex = 1
    cmbGrade.ListIndex = 1
    cmbSex.ListIndex = 0
    isAdding = True
End Sub

Private Sub cmdDelete_Click()
    Dim n%
    If isAdding Then
        isAdding = False
        If objStudent.RecordCount < 1 Then
            txtNews = "记录：无"    '显示无记录提示
            txtNum = "": txtName = ""
            txtPhone = "": txtEmail = ""
            txtHome = "": txtExp = ""
            txtBirth = ""
            cmbDepart.ListIndex = 0
            cmbGrade.ListIndex = 0
        Else
            ShowData            '显示当前记录数据
        End If
    Else
        If objStudent.RecordCount > 0 Then
            n = MsgBox("是否删除当前记录？", vbYesNo + vbQuestion)
            If n = vbYes Then
                objStudent.Delete               '执行删除当前记录操作
                cmdMove(2).Value = True         '显示下一记录数据
            End If
        End If
    End If
End Sub
Private Sub cmdSave_Click()
    Dim strNum$, strName$, strPhone$, strEmail$, strDepart$
    Dim strGrade$, strSex$, strBirth$, strExp$, strHome$
    Dim objCopy As New Recordset
    '在当前表中无数据和不是添加记录时，不执行保存操作
    If Not isAdding And objStudent.RecordCount < 1 Then Exit Sub
    '获得添加或修改的记录数据
    strNum = Trim(txtNum)
    strName = Trim(txtName)
    strPhone = Trim(txtPhone)
    strEmail = Trim(txtEmail)
    strBirth = Trim(txtBirth)
    strHome = Trim(txtHome)
    strExp = Trim(txtExp)
    strSex = cmbSex
    If cmbDepart <> "" Then         '根据系名称获得系编号
        objDepart.MoveFirst
        objDepart.Find "名称='" & cmbDepart & "'"
        strDepart = objDepart.Fields("编号")
    End If
    If cmbGrade <> "" Then          '根据班级名称获得系编号
        objGrade.MoveFirst
        objGrade.Find "名称='" & cmbGrade & "'"
        strGrade = objGrade.Fields("编号")
    End If
    If Trim(txtName) = "" Then      '检验是否输入学生姓名
        MsgBox "学生姓名不能为空！", vbCritical, "学生信息管理"
        txtName.SetFocus
        txtName = ""
        Exit Sub
    End If
    If Len(strNum) <> 8 Then        '检验是否输入学生编号
        MsgBox "学号必须为8位数字！", vbCritical, "学生信息管理"
        txtNum.SetFocus
        txtNum.SelStart = 0
        txtNum.SelLength = Len(txtNum)
        Exit Sub
    End If
    If cmbDepart = "" Then          '检验选择了所属系部
        MsgBox "必须指定学生所属系部！", vbCritical, "学生信息管理"
        cmbDepart.SetFocus
        Exit Sub
    End If
    If cmbGrade = "" Then           '检验选择了所属班级
        MsgBox "必须指定学生所属班级！", vbCritical, "学生信息管理"
        cmbGrade.SetFocus
        Exit Sub
    End If
    If Not IsDate(strBirth) Then    '检验指定的出生日期是否有效
        MsgBox "出生日期无效！", vbCritical, "学生信息管理"
        txtBirth.SetFocus
        txtBirth.SelStart = 0
        txtBirth.SelLength = Len(txtBirth)
        Exit Sub
    End If
    If InStr(strEmail, "@") = 0 Then    '检验指定的Email地址是否有效
        MsgBox "电子邮件地址无效！", vbCritical, "学生信息管理"
        txtEmail.SetFocus
        txtEmail.SelStart = 0
        txtEmail.SelLength = Len(txtEmail)
        Exit Sub
    End If
    '在进一步保存添加的新记录或修改的当前记录之前，检查学号是否重复
    Set objCopy = objStudent.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 <> objStudent.AbsolutePosition) Then
            MsgBox "学号：" & strNum & "已被使用，请使用其他编号！", _
            vbCritical, "学生信息管理"
            txtNum.SetFocus
            txtNum.SelStart = 0
            txtNum.SelLength = Len(txtNum)
            Exit Sub        '学号重复，直接退出
        End If
    End If
    '编号不重复，执行下一步保存操作
    With objStudent
        If isAdding Then .AddNew     '添加新记录
        '保存新记录或修改
        .Fields!学号 = strNum
        .Fields!姓名 = strName
        .Fields!系编号 = strDepart
        .Fields!班编号 = strGrade
        .Fields!性别 = strSex
        .Fields!生日 = strBirth
        .Fields!住址 = strHome
        .Fields!电话 = strPhone
        .Fields!Email = strEmail
        .Fields!简历 = strExp
        '执行更新操作
        .Update
        MsgBox "数据保存成功！", vbInformation, "学生信息管理"
        isAdding = False
        '显示当前记录编号和记录总数
        txtNews = "记录：" & .AbsolutePosition & "/" & .RecordCount
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    objCn.Open
    Set objStudent.ActiveConnection = objCn
    objStudent.UpdateBatch
    objCn.Close                 '关闭数据连接
    Set objCn = Nothing         '释放数据库连接
    Set objStudent = 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

Private Sub ShowData()
    With objStudent         '显示当前记录数据
        txtName = .Fields!姓名
        txtNum = .Fields!学号
        txtBirth = .Fields!生日
        If IsNull(.Fields!电话) Then txtPhone = "" Else txtPhone = .Fields!电话
        If IsNull(.Fields!Email) Then txtEmail = "" Else txtEmail = .Fields!Email
        If IsNull(.Fields!住址) Then txtHome = "" Else txtHome = .Fields!住址
        If IsNull(.Fields!简历) Then txtExp = "" Else txtExp = .Fields!简历
        cmbSex.ListIndex = IIf(.Fields!性别 = "男", 0, 1)
        objDepart.MoveFirst
        objDepart.Find "编号='" & .Fields!系编号 & "'"   '根据系编号显示系名称
        cmbDepart.ListIndex = objDepart.AbsolutePosition
        objGrade.MoveFirst
        objGrade.Find "编号='" & .Fields!班编号 & "'"    '根据班级编号显示班级名称
        cmbGrade.ListIndex = objGrade.AbsolutePosition
        '显示当前记录编号和记录总数
        txtNews = "记录：" & objStudent.AbsolutePosition & "/" & objStudent.RecordCount
    End With
End Sub