frmselect.frm

上机考试系统

      Left            =   622
      TabIndex        =   18
      Top             =   2274
      Width           =   450
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "选项C"
      Height          =   180
      Left            =   622
      TabIndex        =   17
      Top             =   2632
      Width           =   450
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "题干内容"
      Height          =   180
      Left            =   622
      TabIndex        =   16
      Top             =   315
      Width           =   720
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "选项A"
      Height          =   180
      Left            =   622
      TabIndex        =   15
      Top             =   1916
      Width           =   450
   End
End
Attribute VB_Name = "SelectOne"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim isAdding As Boolean             '定义操作状态标志
Dim objSelect 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 objSelect = New Recordset                 '实例化objSelect对象
    With objSelect
        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 objSelect
        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
        Show_Data
    End With
    If isAdding Then isAdding = False
End Sub

Private Sub cmdAdd_Click()
    txtNews = "添加新记录"
    txtQuestion = ""
    txtA = "": txtB = ""
    txtC = "": txtD = ""
    optA = True
    txtPoint = "1"
    txtParse = ""
    isAdding = True
    txtQuestion.SetFocus
End Sub

Private Sub cmdDelete_Click()
    '根据是否处于添加记录状态执行不同的操作
    If isAdding Then
        '退出添加记录状态，显示当前记录
        isAdding = False
        If objSelect.RecordCount <= 0 Then
            txtNews = "记录：无"    '显示无记录提示
        Else
            Show_Data               '显示当前记录数据
        End If
    Else
        If objSelect.RecordCount > 0 Then
            If MsgBox("是否删除当前记录？", vbYesNo + vbQuestion, _
                       "单项选择题管理") = vbYes Then
                objSelect.Delete            '执行删除当前记录操作
                cmdMove(2).Value = True '显示下一记录数据
            Else
                Show_Data   '显示当前记录数据
            End If
        End If
    End If
End Sub
Private Sub cmdSave_Click()
    Dim objCopy As New Recordset
    '在当前表中无数据和不是添加记录时，不执行保存操作
    If Not isAdding And objSelect.RecordCount < 1 Then Exit Sub
    If Trim(txtQuestion) = "" Then
        MsgBox "题干不能为空！", vbCritical, "单项选择题管理"
        txtQuestion.SetFocus: txtQuestion = ""
    ElseIf Trim(txtA) = "" Then
        MsgBox "请输入选项A！", vbCritical, "单项选择题管理"
        txtA.SetFocus: txtA = ""
    ElseIf Trim(txtB) = "" Then
        MsgBox "请输入选项B！", vbCritical, "单项选择题管理"
        txtB.SetFocus: txtB = ""
    ElseIf Trim(txtC) = "" Then
        MsgBox "请输入选项C！", vbCritical, "单项选择题管理"
        txtC.SetFocus: txtC = ""
    ElseIf Trim(txtD) = "" Then
        MsgBox "请输入选项D！", vbCritical, "单项选择题管理"
        txtD.SetFocus: txtD = ""
    ElseIf Not txtPoint Like "[1-9]" Then
        MsgBox "请输入有效的分数！", vbCritical, "单项选择题管理"
        txtPoint.SetFocus
        txtPoint.SelStart = 0: txtPoint.SelLength = Len(txtPoint)
    Else
        Set objCopy = objSelect.Clone
        With objCopy
            If .RecordCount > 0 Then
                '检查题干是否重复
                .MoveFirst
                .Find "题干='" & Trim(txtQuestion) & "'"
                If (isAdding And Not .EOF) Or _
                    (Not isAdding And Not .EOF And _
                     .AbsolutePosition <> objSelect.AbsolutePosition) Then
                    MsgBox "试题重复，请修改！", vbCritical, "单项选择题管理"
                    txtQuestion.SetFocus
                    txtQuestion.SelStart = 0
                    txtQuestion.SelLength = Len(txtQuestion)
                    Exit Sub
                End If
                If isAdding Then objSelect.AddNew       '添加新记录
            Else
                If isAdding Then objSelect.AddNew       '添加新记录
            End If
            objSelect.Fields("题干") = Trim(txtQuestion)
            objSelect.Fields("选项a") = Trim(txtA)
            objSelect.Fields("选项b") = Trim(txtB)
            objSelect.Fields("选项c") = Trim(txtC)
            objSelect.Fields("选项d") = Trim(txtD)
            objSelect.Fields("分数") = Trim(txtPoint)
            objSelect.Fields("答案") = Switch(optA, "A", optB, "B", optC, "C", optD, "D")
            If Trim(txtParse) <> "" Then objSelect.Fields("解析") = Trim(txtParse)
            objSelect.Update
            MsgBox "数据保存成功！", vbInformation, "单项选择题管理"
            isAdding = False
            '显示当前记录编号和记录总数
            txtNews = "记录：" & objSelect.AbsolutePosition & "/" & objSelect.RecordCount
        End With
    End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
    objCn.Close                 '关闭数据联接
    Set objCn = Nothing         '释放数据库联接
    Set objSelect = Nothing      '释放记录集对象
End Sub

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

Private Sub Show_Data()
    Dim i%
    With objSelect
        If .RecordCount < 1 Then
            txtNews = "记录：无"    '显示无记录提示
            '清除显示数据
            txtQuestion = "": txtPoint = "": txtParse = ""
            txtA = "": txtB = "": txtC = "": txtD = ""
        Else
            '显示当前记录数据
            txtQuestion = .Fields("题干"): txtPoint = .Fields("分数")
            If IsNull(.Fields("解析")) Then
                txtParse = ""
            Else
                txtParse = .Fields("解析")
            End If
            txtA = .Fields("选项a"): txtB = .Fields("选项b")
            txtC = .Fields("选项c"): txtD = .Fields("选项d")
            '显示参考答案
            Select Case .Fields("答案")
                Case "A"
                    optA = True
                Case "B"
                    optB = True
                Case "C"
                    optC = True
                Case "D"
                    optD = True
            End Select
            '显示当前记录编号和记录总数
            txtNews = "记录：" & .AbsolutePosition & "/" & .RecordCount
        End If
    End With
End Sub