frmtestdiy.frm

上机考试系统

Private Sub cmdExit_Click()
    Unload Me                           '关闭手工选题窗口
    SelectTest.Show                     '显示试卷定制窗口
End Sub

Private Sub cmdOk_Click()
    Dim i%, s%, a, b, c, d
    '检查是否选足小题数
    If iJ > lstJudge.ListCount Then
        MsgBox "未选够判断题，还差" & Trim(Str(iJ - lstJudge.ListCount)) _
                & "道题！", vbCritical, Me.Caption
    ElseIf iSO > lstSelOne.ListCount Then
        MsgBox "未选够选择题，还差" & Trim(Str(iSO - lstSelOne.ListCount)) _
                & "道题！", vbCritical, Me.Caption
    ElseIf iPR > iDPR(1) + iDPR(2) * 2 + iDPR(3) * 3 Then
            MsgBox "未选够程序阅读题，还差" _
                    & Trim(Str(iPR - (iDPR(1) + iDPR(2) * 2 + iDPR(3) * 3))) _
                    & "道题！", vbCritical, Me.Caption
    ElseIf iPF > iDPF(1) * 2 + iDPF(2) * 3 + iDPF(3) * 4 Then
            MsgBox "未选够程序填空题，还差" _
                    & Trim(Str(iPF - (iDPF(1) * 2 + iDPF(2) * 3 + iDPF(3) * 4))) _
                    & "道题！", vbCritical, Me.Caption
    Else
        '保存选择的试题
        For i = 0 To lstJudge.ListCount - 1
            vJ(i + 1) = Val(lstJudge.List(i))
        Next
        SelectTest.Judge = vJ           '使用属性过程返回选择试题
        For i = 0 To lstSelOne.ListCount - 1
            vS(i + 1) = Val(lstSelOne.List(i))
        Next
        SelectTest.SelOne = vS           '使用属性过程返回选择试题
        For i = 0 To lstProRead.ListCount - 1
            vPR(i + 1) = Val(lstProRead.List(i))
        Next
        For i = lstProRead.ListCount + 1 To UBound(vPR)
            vPR(i) = 0
        Next
        SelectTest.ProRead = vPR           '使用属性过程返回选择试题
        For i = 0 To lstProFill.ListCount - 1
            vPF(i + 1) = Val(lstProFill.List(i))
        Next
        For i = lstProFill.ListCount + 1 To UBound(vPF)
            vPF(i) = 0
        Next
        SelectTest.ProFill = vPF           '使用属性过程返回选择试题
        Unload Me                           '关闭手工选题窗口
        SelectTest.Show                     '显示试卷定制窗口
    End If
End Sub

Private Sub Form_Load()
    Dim i%, m%, Code$, j%
    Set objTemp = objJudge.Clone
    cmdMove(0).Value = True
    cmbType.ListIndex = 0
    '获得各类型题的小题数量
    iJ = Val(SelectTest.txtSum(0))
    iSO = Val(SelectTest.txtSum(1))
    iPR = Val(SelectTest.txtSum(2))
    iPF = Val(SelectTest.txtSum(3))
    For i = 1 To 3
        iDivPR(i) = Val(SelectTest.txtDivSum(i - 1))
        iDivPF(i) = Val(SelectTest.txtDivSum(i + 2))
    Next
    '计算已选程序阅读和程序填空的分题数
    vJ = SelectTest.Judge
    vS = SelectTest.SelOne
    vPR = SelectTest.ProRead
    vPF = SelectTest.ProFill
    For i = 0 To 3
        iDPR(i) = 0
        iDPF(i) = 0
    Next
    For i = 0 To UBound(vPF)
        If vPF(i) <> 0 Then
            Code = Trim(Str(vPF(i)))
            With objProFill
                '计算选中题的分题干数
                .MoveFirst
                .Find "编号=" & Code & ""
                m = 0
                For j = 1 To 4
                    If .Fields("空" & Chr(96 + j)) <> "" Then m = m + 1
                Next
                iDPF(m - 1) = iDPF(m - 1) + 1
            End With
        End If
    Next
    For i = 0 To UBound(vPR)
        If vPR(i) <> 0 Then
            Code = Trim(Str(vPR(i)))
            With objProRead
                '计算选中题的分题干数
                .MoveFirst
                .Find "编号=" & Code & ""
                m = 0
                For j = 1 To 3
                    If .Fields("分题干" & Trim(Str(j))) <> "" Then m = m + 1
                Next
                iDPR(m) = iDPR(m) + 1
            End With
        End If
    Next
    For i = 0 To 2
        lblPF(i) = "应选" & Trim(Str(iDivPF(i + 1))) & "道，差" _
                                    & Trim(Str(iDivPF(i + 1) - iDPF(i + 1))) & "道"
        lblPR(i) = "应选" & Trim(Str(iDivPR(i + 1))) & "道，差" _
                                & Trim(Str(iDivPR(i + 1) - iDPR(i + 1))) & "道"
    Next
    lblJudge = "判断题(" & SelectTest.txtSum(0) & ")"
    lblSelOne = "选择题(" & SelectTest.txtSum(1) & ")"
    lblProRead = "程序阅读题(" & SelectTest.txtSum(2) & ")"
    lblProFill = "程序填空题(" & SelectTest.txtSum(3) & ")"
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set objTemp = Nothing
End Sub
Private Sub cmdMove_Click(Index As Integer)
    With objTemp
        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
        If .RecordCount < 1 Then
            txtNews = "记录：无"    '显示无记录提示
            txtTest = ""
        Else
            '显示当前记录数据
            Show_Data
        End If
    End With
End Sub

Private Sub Add_Item(objList As ListBox)
    Dim Code$, i%, m%, j%
    Code = objTemp.Fields("编号")
    If objList.ListCount > 0 Then
        '检查是否已存在相同题号
        For i = 0 To objList.ListCount - 1
            If objList.List(i) = Code Then Exit For
        Next
        If i < objList.ListCount Then
            MsgBox "已选择了该题！", vbCritical, Me.Caption
        Else
            If cmbType.ListIndex = 2 Then
                '计算选中题的分题干数
                m = 0
                For j = 1 To 3
                    If objTemp.Fields("分题干" & Trim(Str(j))) <> "" Then m = m + 1
                Next
                If iDivPR(m) = 0 Then
                    MsgBox "你没有设置选择分题干数为" & Trim(Str(m)) & "程序阅读题！", _
                        vbCritical, Me.Caption
                ElseIf iDPR(m) < iDivPR(m) Then
                    objList.AddItem Code
                    iDPR(m) = iDPR(m) + 1
                    lblPR(m - 1) = "应选" & Trim(Str(iDivPR(m))) & "道，差" _
                                    & Trim(Str(iDivPR(m) - iDPR(m))) & "道"
                Else
                    MsgBox "分题干数为" & Trim(Str(m)) & "已够！", vbCritical, Me.Caption
                End If
            ElseIf cmbType.ListIndex = 3 Then
                '计算选中题的填空数
                m = 0
                For j = 1 To 4
                    If objTemp.Fields("空" & Chr(96 + j)) <> "" Then m = m + 1
                Next
                If iDivPF(m - 1) = 0 Then
                    MsgBox "你没有设置选择填空数为" & Trim(Str(m)) & "程序填空题！", _
                            vbCritical, Me.Caption
                ElseIf iDPF(m - 1) < iDivPF(m - 1) Then
                    objList.AddItem Code
                    iDPF(m - 1) = iDPF(m - 1) + 1
                    lblPF(m - 2) = "应选" & Trim(Str(iDivPF(m - 1))) & "道，差" _
                                   & Trim(Str(iDivPF(m - 1) - iDPF(m - 1))) & "道"
                Else
                    MsgBox "填空数为" & Trim(Str(m)) & "已够！", vbCritical, Me.Caption
                End If
            Else
                objList.AddItem Code
            End If
        End If
    Else
        If cmbType.ListIndex = 2 Then
            '计算选中题的分题干数
            m = 0
            For j = 1 To 3
                If objTemp.Fields("分题干" & Trim(Str(j))) <> "" Then m = m + 1
            Next
            If iDivPR(m) = 0 Then
                MsgBox "你没有设置选择填空数为" & Trim(Str(m)) & "程序填空题！", _
                        vbCritical, Me.Caption
            Else
                objList.AddItem Code
                iDPR(m) = iDPR(m) + 1
                lblPR(m - 1) = "应选" & Trim(Str(iDivPR(m))) & "道，差" _
                                & Trim(Str(iDivPR(m) - iDPR(m))) & "道"
            End If
        ElseIf cmbType.ListIndex = 3 Then
            '计算选中题的填空数
            m = 0
            For j = 1 To 4
                If objTemp.Fields("空" & Chr(96 + j)) <> "" Then m = m + 1
            Next
            If iDivPF(m - 1) = 0 Then
                MsgBox "你没有设置选择填空数为" & Trim(Str(m)) & "程序填空题！", _
                        vbCritical, Me.Caption
            Else
                objList.AddItem Code
                iDPF(m - 1) = iDPF(m - 1) + 1
                lblPF(m - 2) = "应选" & Trim(Str(iDivPF(m - 1))) & "道，差" _
                               & Trim(Str(iDivPF(m - 1) - iDPF(m - 1))) & "道"
            End If
        Else
            objList.AddItem Code
        End If
    End If
End Sub

Private Sub lstJudge_Click()
    '显示试题内容
    cmbType.ListIndex = 0
    Set objTemp = objJudge.Clone
    objTemp.Find "编号='" & lstJudge.List(lstJudge.ListIndex) & "'"
    Show_Data
End Sub

Private Sub lstSelOne_Click()
    '显示试题内容
    cmbType.ListIndex = 1
    Set objTemp = objSelOne.Clone
    objTemp.Find "编号='" & lstSelOne.List(lstSelOne.ListIndex) & "'"
    Show_Data
End Sub
Private Sub lstProRead_Click()
    '显示试题内容
    cmbType.ListIndex = 2
    Set objTemp = objProRead.Clone
    objTemp.Find "编号='" & lstProRead.List(lstProRead.ListIndex) & "'"
    Show_Data
End Sub
Private Sub lstProFill_Click()
    '显示试题内容
    cmbType.ListIndex = 3
    Set objTemp = objProFill.Clone
    objTemp.Find "编号='" & lstProFill.List(lstProFill.ListIndex) & "'"
    Show_Data
End Sub

Private Sub lstJudge_DblClick()
    lstJudge.RemoveItem lstJudge.ListIndex
End Sub

Private Sub lstSelOne_DblClick()
    lstSelOne.RemoveItem lstSelOne.ListIndex
End Sub

Private Sub lstProFill_DblClick()
    Dim Code$, m%, i%
    Code = lstProFill.List(lstProFill.ListIndex)
    lstProFill.RemoveItem lstProFill.ListIndex
    With objProFill
        '计算选中题的分题干数
        .MoveFirst
        .Find "编号=" & Code & ""
        m = 0
        For i = 1 To 4
            If .Fields("空" & Chr(96 + i)) <> "" Then m = m + 1
        Next
        iDPF(m - 1) = iDPF(m - 1) - 1
        lblPF(m - 2) = "应选" & Trim(Str(iDivPF(m - 1))) & "道，差" _
                            & Trim(Str(iDivPF(m - 1) - iDPF(m - 1))) & "道"
    End With
End Sub

Private Sub lstProRead_DblClick()
    Dim Code$, m%, i%
    Code = lstProRead.List(lstProRead.ListIndex)
    lstProRead.RemoveItem lstProRead.ListIndex
    With objProRead
        '计算选中题的分题干数
        .MoveFirst
        .Find "编号=" & Code & ""
        m = 0
        For i = 1 To 3
            If .Fields("分题干" & Trim(Str(i))) <> "" Then m = m + 1
        Next
        iDPR(m) = iDPR(m) - 1
        lblPR(m - 1) = "应选" & Trim(Str(iDivPR(m))) & "道，差" _
                            & Trim(Str(iDivPR(m) - iDPF(m))) & "道"
    End With
End Sub

Private Sub Show_Data()
    Dim strData$
    With objTemp
        Select Case cmbType.ListIndex
            Case 0, 3           '显示判断题或程序填空题
                txtTest = "编号：" & .Fields("编号") & vbCrLf & .Fields("题干")
            Case 1              '显示选择题
                txtTest = "编号：" & .Fields("编号") & vbCrLf & .Fields("题干")
                txtTest = txtTest & vbCrLf & " （A）" & .Fields("选项a")
                txtTest = txtTest & vbCrLf & " （B）" & .Fields("选项b")
                txtTest = txtTest & vbCrLf & " （C）" & .Fields("选项c")
                txtTest = txtTest & vbCrLf & " （D）" & .Fields("选项d")
            Case 2              '显示程序阅读题
                txtTest = "编号：" & .Fields("编号") & vbCrLf _
                            & .Fields("题干") & vbCrLf & "（1）" & .Fields("分题干1")
                strData = Replace(.Fields("选项1a"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                txtTest = txtTest & vbCrLf & "     （A）" & strData
                strData = Replace(.Fields("选项1b"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                txtTest = txtTest & vbCrLf & "     （B）" & strData
                strData = Replace(.Fields("选项1c"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                txtTest = txtTest & vbCrLf & "     （C）" & strData
                strData = Replace(.Fields("选项1d"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                txtTest = txtTest & vbCrLf & "     （D）" & strData
                If .Fields("分题干2") <> "" Then
                    txtTest = txtTest & vbCrLf & "（2）" & .Fields("分题干2")
                    strData = Replace(.Fields("选项2a"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                    txtTest = txtTest & vbCrLf & "     （A）" & strData
                    strData = Replace(.Fields("选项2b"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                    txtTest = txtTest & vbCrLf & "     （B）" & strData
                    strData = Replace(.Fields("选项2c"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                    txtTest = txtTest & vbCrLf & "     （C）" & strData
                    strData = Replace(.Fields("选项2d"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                    txtTest = txtTest & vbCrLf & "     （D）" & strData
                End If
                If .Fields("分题干3") <> "" Then
                    If .Fields("分题干2") <> "" Then
                        txtTest = txtTest & vbCrLf & "（3）" & .Fields("分题干3")
                    Else
                        txtTest = txtTest & vbCrLf & "（2）" & .Fields("分题干3")
                    End If
                    strData = Replace(.Fields("选项3a"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                    txtTest = txtTest & vbCrLf & "     （A）" & strData
                    strData = Replace(.Fields("选项3b"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                    txtTest = txtTest & vbCrLf & "     （B）" & strData
                    strData = Replace(.Fields("选项3c"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                    txtTest = txtTest & vbCrLf & "     （C）" & strData
                    strData = Replace(.Fields("选项3d"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
                    txtTest = txtTest & vbCrLf & "     （D）" & strData
                End If
        End Select
        '显示当前记录编号和记录总数
        txtNews = "记录：" & .AbsolutePosition & "/" & .RecordCount
    End With
End Sub