frmproreading.frm

上机考试系统

         Top             =   0
         Width           =   1185
      End
   End
   Begin VB.Label Label8 
      AutoSize        =   -1  'True
      Caption         =   "试题解析"
      Height          =   180
      Left            =   5228
      TabIndex        =   31
      Top             =   4830
      Width           =   720
   End
   Begin VB.Label Label7 
      AutoSize        =   -1  'True
      Caption         =   "参考分数"
      Height          =   180
      Left            =   5228
      TabIndex        =   30
      Top             =   4500
      Width           =   720
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "程序代码"
      Height          =   180
      Left            =   263
      TabIndex        =   29
      Top             =   210
      Width           =   720
   End
End
Attribute VB_Name = "ProgramReading"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim isAdding As Boolean             '定义操作状态标志
Dim objProReading 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 objProReading = New Recordset                 '实例化objProReading对象
    With objProReading
        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 objProReading
        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()
    Dim i%
    txtNews = "添加新记录"
    txtQuestion = ""
    For i = 0 To 2
        txtDiv(i) = "": txtA(i) = "": txtB(i) = ""
        txtC(i) = "": txtD(i) = ""
        optA(i) = True
    Next
    txtPoint = "3": txtParse = ""
    isAdding = True
    txtQuestion.SetFocus
    SSTab1.Tab = 0                                  '显示分题干1选项卡
End Sub

Private Sub cmdDelete_Click()
    '根据是否处于添加记录状态执行不同的操作
    If isAdding Then                '退出添加记录状态，显示当前记录
        isAdding = False
        If objProReading.RecordCount <= 0 Then
            txtNews = "记录：无"    '显示无记录提示
        Else
            Show_Data               '显示当前记录数据
        End If
    Else
        If objProReading.RecordCount > 0 Then
            If MsgBox("是否删除当前记录？", vbYesNo + vbQuestion, _
                       "程序阅读题管理") = vbYes Then
                objProReading.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, i%
    '在当前表中无数据和不是添加记录时，不执行保存操作
    If Not isAdding And objProReading.RecordCount < 1 Then Exit Sub
    '检查是否输入程序阅读题程序代码
    If Trim(txtQuestion) = "" Then
        MsgBox "请输入程序阅读题程序代码！", vbCritical, "程序阅读题管理"
        txtQuestion.SetFocus: txtQuestion = ""
        Exit Sub
    End If
    '检查是否输入必须的分题干1及其选项
    If Trim(txtDiv(0)) = "" And i = 0 Then
        MsgBox "请输入分题干1！", vbCritical, "程序阅读题管理"
        SSTab1.Tab = 0
        txtDiv(0).SetFocus: txtDiv(0) = ""
        Exit Sub
    Else
        If Trim(txtA(0)) = "" Then
            MsgBox "请输入分题干1选项A！", vbCritical, "程序阅读题管理"
            SSTab1.Tab = 0
            txtA(0).SetFocus: txtA(0) = ""
            Exit Sub
        ElseIf Trim(txtB(0)) = "" Then
            MsgBox "请输入分题干1选项B！", vbCritical, "程序阅读题管理"
            SSTab1.Tab = 0
            txtB(0).SetFocus: txtB(0) = ""
            Exit Sub
        ElseIf Trim(txtC(0)) = "" Then
            MsgBox "请输入分题干1选项C！", vbCritical, "程序阅读题管理"
            SSTab1.Tab = 0
            txtC(0).SetFocus: txtC(0) = ""
            Exit Sub
        ElseIf Trim(txtD(0)) = "" Then
            MsgBox "请输入分题干1选项D！", vbCritical, "程序阅读题管理"
            SSTab1.Tab = 0
            txtD(0).SetFocus: txtD(0) = ""
            Exit Sub
        End If
    End If
    '检查是否输入分题干2、3及其选项
    For i = 1 To 2
        If Trim(txtDiv(i)) <> "" Then
            If Trim(txtA(i)) = "" Then
                MsgBox "请输入分题干" & Trim(Str(i + 1)) & "选项A！", vbCritical, "程序阅读题管理"
                SSTab1.Tab = i
                txtA(i).SetFocus: txtA(i) = ""
                Exit Sub
            ElseIf Trim(txtB(i)) = "" Then
                MsgBox "请输入分题干" & Trim(Str(i + 1)) & "选项B！", vbCritical, "程序阅读题管理"
                SSTab1.Tab = i
                txtB(i).SetFocus: txtB(i) = ""
                Exit Sub
            ElseIf Trim(txtC(i)) = "" Then
                MsgBox "请输入分题干" & Trim(Str(i + 1)) & "选项C！", vbCritical, "程序阅读题管理"
                SSTab1.Tab = i
                txtC(i).SetFocus: txtC(i) = ""
                Exit Sub
            ElseIf Trim(txtD(i)) = "" Then
                MsgBox "请输入分题干" & Trim(Str(i + 1)) & "选项D！", vbCritical, "程序阅读题管理"
                SSTab1.Tab = i
                txtD(i).SetFocus: txtD(i) = ""
                Exit Sub
            End If
        End If
    Next
    If Not txtPoint Like "[1-9]" Then
        MsgBox "请输入有效的分数！", vbCritical, "程序阅读题管理"
        txtPoint.SetFocus
        txtPoint.SelStart = 0: txtPoint.SelLength = Len(txtPoint)
        Exit Sub
    End If
    Set objCopy = objProReading.Clone
    With objCopy
        If .RecordCount > 0 Then
            '检查程序阅读题是否重复
            .MoveFirst
            .Find "题干='" & Trim(txtQuestion) & "'"
            If (isAdding And Not .EOF) Or _
                (Not isAdding And Not .EOF And _
                 .AbsolutePosition <> objProReading.AbsolutePosition) Then
                MsgBox "试题重复，请修改！", vbCritical, "程序阅读题管理"
                txtQuestion.SetFocus
                txtQuestion.SelStart = 0
                txtQuestion.SelLength = Len(txtQuestion)
                Exit Sub
            End If
        End If
        '保存或添加新记录
        If isAdding Then objProReading.AddNew
        objProReading.Fields("题干") = Trim(txtQuestion)
        objProReading.Fields("分题干1") = Trim(txtDiv(0))
        objProReading.Fields("选项1a") = Trim(txtA(0))
        objProReading.Fields("选项1b") = Trim(txtB(0))
        objProReading.Fields("选项1c") = Trim(txtC(0))
        objProReading.Fields("选项1d") = Trim(txtD(0))
        objProReading.Fields("答案1") = Switch(optA(0), "A", optB(0), "B", optC(0), "C", optD(0), "D")
        For i = 1 To 2
            If txtDiv(i) <> "" Then
                objProReading.Fields("分题干" & Trim(Str(i + 1)) & "") = Trim(txtDiv(i))
                objProReading.Fields("选项" & Trim(Str(i + 1)) & "a") = Trim(txtA(i))
                objProReading.Fields("选项" & Trim(Str(i + 1)) & "b") = Trim(txtB(i))
                objProReading.Fields("选项" & Trim(Str(i + 1)) & "c") = Trim(txtC(i))
                objProReading.Fields("选项" & Trim(Str(i + 1)) & "d") = Trim(txtD(i))
                objProReading.Fields("答案" & Trim(Str(i + 1)) & "") = Switch(optA(i), "A", optB(i), "B", optC(i), "C", optD(i), "D")
            Else
                objProReading.Fields("分题干" & Trim(Str(i + 1)) & "") = ""
                objProReading.Fields("选项" & Trim(Str(i + 1)) & "a") = ""
                objProReading.Fields("选项" & Trim(Str(i + 1)) & "b") = ""
                objProReading.Fields("选项" & Trim(Str(i + 1)) & "c") = ""
                objProReading.Fields("选项" & Trim(Str(i + 1)) & "d") = ""
                objProReading.Fields("答案" & Trim(Str(i + 1)) & "") = ""
            End If
        Next
        objProReading.Fields("分数") = Trim(txtPoint)
        objProReading.Fields("解析") = Trim(txtParse)
        objProReading.Update
        MsgBox "数据保存成功！", vbInformation, "程序阅读题管理"
        isAdding = False
        '显示当前记录编号和记录总数
        txtNews = "记录：" & objProReading.AbsolutePosition & "/" & objProReading.RecordCount
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    objCn.Close                 '关闭数据联接
    Set objCn = Nothing         '释放数据库联接
    Set objProReading = 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 objProReading
        If .RecordCount < 1 Then
            txtNews = "记录：无"    '显示无记录提示
            '清除显示数据
            txtQuestion = "": txtPoint = "": txtParse = ""
            For i = 0 To 2
                txtDiv(i) = "": txtA(i) = "": txtB(i) = ""
                txtC(i) = "": txtD(i) = "": optA(i) = True
            Next
        Else
            '显示当前记录数据
            txtQuestion = .Fields("题干")
            txtPoint = .Fields("分数")
            txtParse = .Fields("解析")
            For i = 0 To 2
                txtDiv(i) = .Fields("分题干" & Trim(Str(i + 1)))
                txtA(i) = .Fields("选项" & Trim(Str(i + 1)) & "a")
                txtB(i) = .Fields("选项" & Trim(Str(i + 1)) & "b")
                txtC(i) = .Fields("选项" & Trim(Str(i + 1)) & "c")
                txtD(i) = .Fields("选项" & Trim(Str(i + 1)) & "d")
                Select Case .Fields("答案" & Trim(Str(i + 1)))
                    Case "A"
                        optA(i) = True
                    Case "B"
                        optB(i) = True
                    Case "C"
                        optC(i) = True
                    Case "D"
                        optD(i) = True
                End Select
            Next
            '显示当前记录编号和记录总数
            txtNews = "记录：" & .AbsolutePosition & "/" & .RecordCount
        End If
    End With
    SSTab1.Tab = 0
End Sub