frmtesting.frm

上机考试系统

        '计算实际小题数
        m = 0
        While Not .EOF
            objProRead.MoveFirst
            objProRead.Find "编号=" & .Fields("编号") & ""
            For i = 1 To 3
                If objProRead.Fields("分题干" & Trim(Str(i))) <> "" Then m = m + 1
            Next
            .MoveNext
        Wend
        s = s + s1 * m
        lblNews = lblNews & vbCrLf & "三、程序阅读题(" & Trim(Str(m)) & "小题,每题" & Trim(Str(s1)) _
                & "分,共" & Trim(Str(s1 * m)) & "分)"
        .Filter = "题型='程序填空'"
        iPF = .RecordCount
        n = n + .RecordCount * 4
        s1 = .Fields("分数")
        '计算实际小题数
        m = 0
        While Not .EOF
            objProFill.MoveFirst
            objProFill.Find "编号=" & .Fields("编号") & ""
            For i = 1 To 4
                If objProFill.Fields("空" & Chr(i + 96)) <> "" Then m = m + 1
            Next
            .MoveNext
        Wend
        s = s + s1 * m
        lblNews = lblNews & vbCrLf & "四、程序填空题(" & Trim(Str(m)) & "小题,每题" & Trim(Str(s1)) _
                & "分,共" & Trim(Str(s1 * m)) & "分)"
        lblNews = "本试卷共4大题,总分" & Trim(Str(s)) & "分" & vbCrLf & lblNews
        '重定义保存本次试题数据的数组
        ReDim strTest(n, 2)
        iTotal = n
        '获取判断题数据
        .Filter = "题型='判断题'"
        n = 1
        .MoveFirst
        While Not .EOF
            strTest(n, 1) = Trim(Str(.Fields("编号")))
            n = n + 1
            .MoveNext
        Wend
        '获取选择题数据
        .Filter = "题型='选择题'"
        .MoveFirst
        While Not .EOF
            strTest(n, 1) = Trim(Str(.Fields("编号")))
            n = n + 1
            .MoveNext
        Wend
        '获取程序填空题数据
        .Filter = "题型='程序阅读'"
        i = 1
        .MoveFirst
        While Not .EOF
            strTest(n, 1) = Trim(Str(.Fields("编号")))
            n = n + 1
            i = i + 1
            If i > 3 Then
                i = 1
                .MoveNext
            End If
        Wend
        '获取程序填空题数据
        .Filter = "题型='程序填空'"
        i = 1
        .MoveFirst
        While Not .EOF
            strTest(n, 1) = Trim(Str(.Fields("编号")))
            n = n + 1
            i = i + 1
            If i > 4 Then
                i = 1
                .MoveNext
            End If
        Wend
        .Filter = ""
    End With
    cmdMove(0).Value = True                 '显示第一道试题
    objCn.Close
End Sub
Private Sub cmdMove_Click(Index As Integer)
    Dim i%, strData$, n%, p%
    With objTest
        '保存当前试题所作答案
        Select Case .AbsolutePosition
            Case 1 To iJ
                '保存判断题答案
                If optYesNo(0) = True Then strTest(.AbsolutePosition, 2) = "TRUE"
                If optYesNo(1) = True Then strTest(.AbsolutePosition, 2) = "FALSE"
                optYesNo(0) = False
                optYesNo(1) = False
            Case iJ + 1 To iJ + iSO
                '保存选择题答案
                For i = 0 To 3
                    If optSO(i) = True Then strTest(.AbsolutePosition, 2) = Chr(65 + i)
                    optSO(i) = False
                Next
            Case iJ + iSO + 1 To iJ + iSO + iPR
                '保存程序阅读题答案
                p = (.AbsolutePosition - iJ - iSO - 1) * 2
                For i = 0 To 3
                    If optPR1(i) = True Then strTest(.AbsolutePosition + p, 2) = Chr(65 + i)
                    If optPR2(i) = True Then strTest(.AbsolutePosition + p + 1, 2) = Chr(65 + i)
                    If optPR3(i) = True Then strTest(.AbsolutePosition + p + 2, 2) = Chr(65 + i)
                Next
                For i = 0 To 3
                    optPR1(i) = False: optPR2(i) = False: optPR3(i) = False
                Next
            Case iJ + iSO + iPR + 1 To iJ + iSO + iPR + iPF
                '保存程序填空答案
                p = (.AbsolutePosition - iJ - iSO - iPR - 1) * 3 + 2 * iPR
                strTest(.AbsolutePosition + p, 2) = Trim(txtBlank(0))
                txtBlank(0) = ""
                strTest(.AbsolutePosition + p + 1, 2) = Trim(txtBlank(1))
                txtBlank(1) = ""
                strTest(.AbsolutePosition + p + 2, 2) = Trim(txtBlank(2))
                txtBlank(2) = ""
                strTest(.AbsolutePosition + p + 3, 2) = Trim(txtBlank(3))
                txtBlank(3) = ""
        End Select
        
        '该变当前记录
        Select Case Index           '切换当前记录
            Case 0                  '使第一个记录成为当前记录
                If .RecordCount > 0 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 Then .MoveLast
        End Select
        
        '显示当前试题内容
        Select Case .AbsolutePosition
            Case 1 To iJ
                '显示判断题内容及所作答案
                lblType = "一、判断题"
                cmbType = "判断题"
                txtTest = Trim(Str(.AbsolutePosition)) & "、"
                objJudge.MoveFirst
                objJudge.Find "编号=" & .Fields("编号") & ""
                txtTest = txtTest & objJudge.Fields("题干")
                If strTest(.AbsolutePosition, 2) = "TRUE" Then optYesNo(0) = True
                If strTest(.AbsolutePosition, 2) = "FALSE" Then optYesNo(1) = True
                frmAnswer(0).Visible = True
                frmAnswer(1).Visible = False
                frmAnswer(2).Visible = False
                frmAnswer(3).Visible = False
            Case iJ + 1 To iJ + iSO
                '显示选择题内容以及所作答案
                cmbType = "选择题"
                lblType = "二、选择题"
                txtTest = Trim(Str(.AbsolutePosition - iJ)) & "、"
                objSelOne.MoveFirst
                objSelOne.Find "编号=" & .Fields("编号") & ""
                txtTest = txtTest & objSelOne.Fields("题干")
                txtTest = txtTest & vbCrLf & " （A）" & objSelOne.Fields("选项a")
                txtTest = txtTest & vbCrLf & " （B）" & objSelOne.Fields("选项b")
                txtTest = txtTest & vbCrLf & " （C）" & objSelOne.Fields("选项c")
                txtTest = txtTest & vbCrLf & " （D）" & objSelOne.Fields("选项d")
                frmAnswer(0).Visible = False
                frmAnswer(1).Visible = True
                frmAnswer(2).Visible = False
                frmAnswer(3).Visible = False
                For i = 0 To 3
                    If strTest(.AbsolutePosition, 2) = Chr(65 + i) Then optSO(i) = True
                Next
            Case iJ + iSO + 1 To iJ + iSO + iPR
                cmbType = "程序阅读题"
                '显示程序阅读内容以及所作答案
                lblType = "三、程序阅读题"
                n = .AbsolutePosition
                p = (n - iJ - iSO - 1) * 2
                txtTest = Trim(Str(n - iJ - iSO)) & "、" & vbCrLf
                objProRead.MoveFirst
                objProRead.Find "编号=" & .Fields("编号") & ""
                
                txtTest = txtTest & objProRead.Fields("题干") & vbCrLf
                txtTest = txtTest & "（1）" & objProRead.Fields("分题干1")
                strData = Replace(objProRead.Fields("选项1a"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                txtTest = txtTest & vbCrLf & "     （A）" & strData
                strData = Replace(objProRead.Fields("选项1b"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                txtTest = txtTest & vbCrLf & "     （B）" & strData
                strData = Replace(objProRead.Fields("选项1c"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                txtTest = txtTest & vbCrLf & "     （C）" & strData
                strData = Replace(objProRead.Fields("选项1d"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                txtTest = txtTest & vbCrLf & "     （D）" & strData
                
                If objProRead.Fields("分题干2") <> "" Then
                    txtTest = txtTest & vbCrLf & "（2）" & objProRead.Fields("分题干2")
                    strData = Replace(objProRead.Fields("选项2a"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                    txtTest = txtTest & vbCrLf & "     （A）" & strData
                    strData = Replace(objProRead.Fields("选项2b"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                    txtTest = txtTest & vbCrLf & "     （B）" & strData
                    strData = Replace(objProRead.Fields("选项2c"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                    txtTest = txtTest & vbCrLf & "     （C）" & strData
                    strData = Replace(objProRead.Fields("选项2d"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                    txtTest = txtTest & vbCrLf & "     （D）" & strData
                    frmDivPR(1).Visible = True
                Else
                    frmDivPR(1).Visible = False
                End If
                
                If objProRead.Fields("分题干3") <> "" Then
                    If objProRead.Fields("分题干2") <> "" Then
                        txtTest = txtTest & vbCrLf & "（3）" & objProRead.Fields("分题干3")
                    Else
                        txtTest = txtTest & vbCrLf & "（2）" & objProRead.Fields("分题干3")
                    End If
                    strData = Replace(objProRead.Fields("选项3a"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                    txtTest = txtTest & vbCrLf & "     （A）" & strData
                    strData = Replace(objProRead.Fields("选项3b"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                    txtTest = txtTest & vbCrLf & "     （B）" & strData
                    strData = Replace(objProRead.Fields("选项3c"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                    txtTest = txtTest & vbCrLf & "     （C）" & strData
                    strData = Replace(objProRead.Fields("选项3d"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                    txtTest = txtTest & vbCrLf & "     （D）" & strData
                    frmDivPR(2).Visible = True
                Else
                    frmDivPR(2).Visible = False
                End If
                frmAnswer(0).Visible = False
                frmAnswer(1).Visible = False
                frmAnswer(2).Visible = True
                frmAnswer(3).Visible = False
                For i = 0 To 3
                    If strTest(.AbsolutePosition + p, 2) = Chr(65 + i) Then optPR1(i) = True
                    If strTest(.AbsolutePosition + p + 1, 2) = Chr(65 + i) Then optPR2(i) = True
                    If strTest(.AbsolutePosition + p + 2, 2) = Chr(65 + i) Then optPR3(i) = True
                Next
            Case iJ + iSO + iPR + 1 To iJ + iSO + iPR + iPF
                cmbType = "程序填空题"
                '显示程序填空题及所作答案
                p = (.AbsolutePosition - iJ - iSO - iPR - 1) * 3 + 2 * iPR
                lblType = "四、程序填空题"
                n = .AbsolutePosition
                txtTest = Trim(Str(n - iJ - iSO - iPR)) & "、" & vbCrLf
                objProFill.MoveFirst
                objProFill.Find "编号=" & .Fields("编号") & ""
                txtTest = txtTest & objProFill.Fields("题干")
                txtBlank(0) = strTest(n + p, 2)
                txtBlank(1) = strTest(n + p + 1, 2)
                txtBlank(2) = strTest(n + p + 2, 2)
                txtBlank(3) = strTest(n + p + 3, 2)
                If objProFill.Fields("空b") = "" Then
                    txtBlank(1).Visible = False
                    lblBlank(1).Visible = False
                Else
                    txtBlank(1).Visible = True
                    lblBlank(1).Visible = True
                End If
                If objProFill.Fields("空c") = "" Then
                    txtBlank(2).Visible = False
                    lblBlank(2).Visible = False
                Else
                    txtBlank(2).Visible = True
                    lblBlank(2).Visible = True
                End If
                If objProFill.Fields("空d") = "" Then
                    txtBlank(3).Visible = False
                    lblBlank(3).Visible = False
                Else
                    txtBlank(3).Visible = True
                    lblBlank(3).Visible = True
                End If
                frmAnswer(0).Visible = False
                frmAnswer(1).Visible = False
                frmAnswer(2).Visible = False
                frmAnswer(3).Visible = True
        End Select
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set objCn = Nothing
    Set objJudge = Nothing
    Set objTest = Nothing
    Set objSelOne = Nothing
    Set objProRead = Nothing
    Set objProFill = Nothing
End Sub