frmclass.frm

上机考试系统

VERSION 5.00
Begin VB.Form Class 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "班级信息管理"
   ClientHeight    =   1980
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4695
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   1980
   ScaleWidth      =   4695
   Begin VB.TextBox txtNum 
      Height          =   270
      IMEMode         =   2  'OFF
      Left            =   1740
      MaxLength       =   8
      TabIndex        =   1
      Top             =   608
      Width           =   2010
   End
   Begin VB.CommandButton cmdSave 
      Caption         =   "保存"
      Height          =   300
      Left            =   2355
      TabIndex        =   4
      Top             =   1073
      Width           =   735
   End
   Begin VB.CommandButton cmdExit 
      Cancel          =   -1  'True
      Caption         =   "退出"
      Height          =   315
      Left            =   3120
      TabIndex        =   5
      Top             =   1066
      Width           =   735
   End
   Begin VB.CommandButton cmdDelete 
      Caption         =   "删除"
      Height          =   300
      Left            =   1605
      TabIndex        =   3
      Top             =   1073
      Width           =   735
   End
   Begin VB.CommandButton cmdAdd 
      Caption         =   "添加"
      Height          =   300
      Left            =   840
      TabIndex        =   2
      Top             =   1073
      Width           =   735
   End
   Begin VB.TextBox txtName 
      Height          =   270
      IMEMode         =   1  'ON
      Left            =   1740
      MaxLength       =   20
      TabIndex        =   0
      Top             =   248
      Width           =   2010
   End
   Begin VB.PictureBox picNavigation 
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   360
      Left            =   1005
      ScaleHeight     =   360
      ScaleWidth      =   2685
      TabIndex        =   10
      Top             =   1373
      Width           =   2685
      Begin VB.CommandButton cmdMove 
         Height          =   300
         Index           =   1
         Left            =   360
         Picture         =   "frmClass.frx":0000
         Style           =   1  'Graphical
         TabIndex        =   7
         Top             =   15
         Width           =   345
      End
      Begin VB.CommandButton cmdMove 
         Height          =   300
         Index           =   0
         Left            =   30
         Picture         =   "frmClass.frx":0045
         Style           =   1  'Graphical
         TabIndex        =   6
         Top             =   15
         Width           =   345
      End
      Begin VB.CommandButton cmdMove 
         Height          =   300
         Index           =   3
         Left            =   2280
         Picture         =   "frmClass.frx":0092
         Style           =   1  'Graphical
         TabIndex        =   9
         Top             =   15
         Width           =   345
      End
      Begin VB.CommandButton cmdMove 
         Height          =   300
         Index           =   2
         Left            =   1950
         Picture         =   "frmClass.frx":00E1
         Style           =   1  'Graphical
         TabIndex        =   8
         Top             =   15
         Width           =   345
      End
      Begin VB.TextBox txtNews 
         Height          =   300
         Left            =   690
         Locked          =   -1  'True
         TabIndex        =   11
         TabStop         =   0   'False
         Top             =   15
         Width           =   1275
      End
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "班级编号"
      Height          =   180
      Left            =   930
      TabIndex        =   13
      Top             =   668
      Width           =   720
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "班级名称"
      Height          =   180
      Left            =   930
      TabIndex        =   12
      Top             =   278
      Width           =   720
   End
End
Attribute VB_Name = "Class"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim isAdding As Boolean             '定义操作状态标志
Dim objGrade As Recordset           '用于保存班级信息记录
Dim objCn As Connection             '用于建立数据库联接

Private Sub cmdExit_Click()
    Unload Me                       '关闭班级信息管理窗体
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 objGrade = New Recordset               '实例化objGrade对象
    With objGrade
        Set .ActiveConnection = objCn           '设置数据库联接
        .CursorLocation = adUseClient           '指定使用客户端游标
        .CursorType = adOpenStatic              '指定使用静态游标
        .LockType = adLockOptimistic
        .Open "SELECT * FROM 班级信息"          '获取班级信息记录
    End With
    '触发按钮单击事件，显示第一个记录
    cmdMove(0).Value = True
End Sub

Private Sub cmdMove_Click(Index As Integer)
    With objGrade
        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 = ""
        Else
            '显示当前记录数据
            ShowData
        End If
    End With
    If isAdding Then isAdding = False
End Sub

Private Sub cmdAdd_Click()
    txtNews = "添加新记录"
    txtNum = ""
    txtName = ""
    isAdding = True
End Sub

Private Sub cmdDelete_Click()
    '根据是否处于添加记录状态执行不同的操作
    If isAdding Then
        '退出添加记录状态，显示当前记录
        isAdding = False
        If objGrade.RecordCount < 1 Then
            txtNews = "记录：无"    '显示无记录提示
            txtNum = ""
            txtName = ""
        Else
            '显示当前记录数据
            ShowData
        End If
    Else
        If objGrade.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, "班级信息管理"
                    .Close                  '关闭对象
                    Set objTemp = Nothing   '释放对象
                    Exit Sub
                End If
                .Close                      '关闭对象
            End With
            Set objTemp = Nothing           '释放对象
            '可以删除，请求确认执行删除操作
            If MsgBox("是否删除当前记录？", vbYesNo + vbQuestion, "班级信息管理") = vbYes Then
                '执行删除当前记录操作
                objGrade.Delete
                '显示下一记录数据
                cmdMove(2).Value = True
            Else
                '显示当前记录数据
                ShowData
            End If
        End If
    End If
End Sub
Private Sub cmdSave_Click()
    '在当前表中无数据和不是添加记录时，不执行保存操作
    If Not isAdding And objGrade.RecordCount < 1 Then Exit Sub
    '获得当前记录数据
    Dim strNum$, strName$
    strNum = Trim(txtNum)
    strName = Trim(txtName)
    '检验是否输入班级名称
    If strName = "" Then
        MsgBox "班级名称不能为空！", vbCritical, "班级信息管理"
        txtName.SetFocus
        txtName = ""
        Exit Sub
    End If
     '检验是否输入班级编号
    If Len(strNum) <> 8 Then
        MsgBox "班级编号必须为8位数字！", vbCritical, "班级信息管理"
        txtNum.SetFocus
        txtNum = ""
        Exit Sub
    End If
    '在进一步保存添加的新记录或修改的当前记录之前，检查班级编号是否重复
    Dim objCopy As New Recordset
    Set objCopy = objGrade.Clone
    If objGrade.RecordCount > 0 And Not isAdding Then
        objCopy.MoveFirst
        objCopy.Find "编号='" & strNum & "'"
        If Not objCopy.EOF And objCopy.AbsolutePosition <> objGrade.AbsolutePosition Then
            MsgBox "班级编号：" & strNum & "已被使用，请使用其他编号！", _
            vbCritical, "班级信息管理"
            txtNum.SetFocus
            txtNum.SelStart = 0
            txtNum.SelLength = Len(txtNum)
            Exit Sub        '班级编号重复，直接退出
        End If
    End If
    '班级编号不重复，执行下一步保存操作
    With objGrade
        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
        '执行更新操作
        .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 objGrade = Nothing          '释放记录集对象
End Sub

Private Sub txtName_KeyPress(KeyAscii As Integer)
    '如果敲回车键，使下一控件获得焦点
    If KeyAscii = vbKeyReturn Then SendKeys "{TAB}"
End Sub

'限制编号输入
Private Sub txtNum_KeyPress(KeyAscii As Integer)
    '如果敲回车键，使保存按钮获得焦点
    If KeyAscii = vbKeyReturn Then cmdSave.SetFocus
    If Not (Chr(KeyAscii) Like "[0-9]" Or KeyAscii = vbKeyBack) Then
        KeyAscii = 0    '输入不是数字或退格键，取消输入
    End If
End Sub


'显示objGrade当前记录信息
Private Sub ShowData()
    With objGrade
        '显示当前记录数据
        txtName = .Fields("名称")
        txtNum = .Fields("编号")
        '显示当前记录编号和记录总数
        txtNews = "记录：" & .AbsolutePosition & "/" & .RecordCount
    End With
End Sub