paperproperty.frm

这是我们公司的题库管理系统

                                '检查本章试题是否已选够
                                For n = 0 To 3
                                    If cmbChapter(i).ItemData(n) = objRsMore!章节 Then Exit For
                                Next
                                If Chapter(i, n) > 0 Then
                                    strTest = strTest & j & "、" & objRsMore!题干 & vbCrLf
                                    strTest = strTest & "    A、" & objRsMore!选项1 & vbCrLf
                                    strTest = strTest & "    B、" & objRsMore!选项2 & vbCrLf
                                    strTest = strTest & "    C、" & objRsMore!选项3 & vbCrLf
                                    strTest = strTest & "    D、" & objRsMore!选项4 & vbCrLf
                                    strAnswer = strAnswer & j & "、"
                                    For more = 0 To 3
                                        If Mid(objRsMore!答案, more + 1, 1) = "1" Then _
                                            strAnswer = strAnswer & Abcd(more) & "，"
                                    Next
                                    strAnswer = strAnswer & vbCrLf
                                    j = j + 1
                                    Chapter(i, n) = Chapter(i, n) - 1
                                    Level1(i) = Level1(i) - 1
                                    Count(i) = Count(i) - 1
                                    If Not IsNull(objRsMore!图片) Then _
                                        strTest = strTest & "本题图片：" & objRsMore!图片
                                End If
                            End If
                        Case 2
                            If Level2(i) > 0 Then
                                '检查本章试题是否已选够
                                For n = 0 To 3
                                    If cmbChapter(i).ItemData(n) = objRsMore!章节 Then Exit For
                                Next
                                If Chapter(i, n) > 0 Then
                                    strTest = strTest & j & "、" & objRsMore!题干 & vbCrLf
                                    strTest = strTest & "    A、" & objRsMore!选项1 & vbCrLf
                                    strTest = strTest & "    B、" & objRsMore!选项2 & vbCrLf
                                    strTest = strTest & "    C、" & objRsMore!选项3 & vbCrLf
                                    strTest = strTest & "    D、" & objRsMore!选项4 & vbCrLf
                                    strAnswer = strAnswer & j & "、"
                                     For more = 0 To 3
                                        If Mid(objRsMore!答案, more + 1, 1) = "1" Then _
                                            strAnswer = strAnswer & Abcd(more) & "，"
                                    Next
                                    strAnswer = strAnswer & vbCrLf
                                    j = j + 1
                                    Chapter(i, n) = Chapter(i, n) - 1
                                    Level2(i) = Level2(i) - 1
                                    Count(i) = Count(i) - 1
                                    If Not IsNull(objRsMore!图片) Then _
                                        strTest = strTest & "本题图片：" & objRsMore!图片
                                End If
                            End If
                    End Select
                Wend
            Case 3  '选择填空题
                strTest = strTest & "四、填空题。（共" & txtCount(i) _
                    & "，每小题" & txtAvg(i) & "分，共" & txtScore(i) & "分）" & vbCrLf
                strAnswer = strAnswer & "四、填空题。（共" & txtCount(i) _
                    & "，每小题" & txtAvg(i) & "分，共" & txtScore(i) & "分）" & vbCrLf
                j = 1
                While Count(i) > 0
                    '随即产生一个未选择的试题的记录序号
                    Do
                        If Timer - doTime > 30 Then
                            MsgBox "本次生成试题花费时间过长，退出重试！", vbCritical
                            Exit Sub
                        End If
                        n = Int(Rnd * objRsSpace.RecordCount + 1)
                    Loop Until InStr(Selected, "#" & n & "#") = 0
                    Selected = Selected & "#" & n & "#"
                    objRsSpace.MoveFirst
                    objRsSpace.Move n - 1
                    Select Case objRsSpace!难度
                        Case 0
                            If Level0(i) > 0 Then
                                '检查本章试题是否已选够
                                For n = 0 To 3
                                    If cmbChapter(i).ItemData(n) = objRsSpace!章节 Then Exit For
                                Next
                                If Chapter(i, n) > 0 Then
                                    strTest = strTest & j & "、" & objRsSpace!题干 & vbCrLf
                                    strAnswer = strAnswer & j & "、" & objRsSpace!答案1
                                    If Not IsNull(objRsSpace!答案1) Then _
                                        strAnswer = strAnswer & "，" & objRsSpace!答案2
                                    j = j + 1
                                    strAnswer = strAnswer & vbCrLf
                                    Chapter(i, n) = Chapter(i, n) - 1
                                    Level0(i) = Level0(i) - 1
                                    Count(i) = Count(i) - 1
                                    If Not IsNull(objRsSpace!图片) Then _
                                        strTest = strTest & "本题图片：" & objRsSpace!图片
                                End If
                            End If
                        Case 1
                            If Level1(i) > 0 Then
                                '检查本章试题是否已选够
                                For n = 0 To 3
                                    If cmbChapter(i).ItemData(n) = objRsSpace!章节 Then Exit For
                                Next
                                If Chapter(i, n) > 0 Then
                                    strTest = strTest & j & "、" & objRsSpace!题干 & vbCrLf
                                    strAnswer = strAnswer & j & "、" & objRsSpace!答案1
                                    If Not IsNull(objRsSpace!答案1) Then _
                                        strAnswer = strAnswer & "，" & objRsSpace!答案2
                                    j = j + 1
                                    strAnswer = strAnswer & vbCrLf
                                    Chapter(i, n) = Chapter(i, n) - 1
                                    Level1(i) = Level1(i) - 1
                                    Count(i) = Count(i) - 1
                                    If Not IsNull(objRsSpace!图片) Then _
                                        strTest = strTest & "本题图片：" & objRsSpace!图片
                                End If
                            End If
                        Case 2
                            If Level2(i) > 0 Then
                                '检查本章试题是否已选够
                                For n = 0 To 3
                                    If cmbChapter(i).ItemData(n) = objRsSpace!章节 Then Exit For
                                Next
                                If Chapter(i, n) > 0 Then
                                    strTest = strTest & j & "、" & objRsSpace!题干 & vbCrLf
                                    strAnswer = strAnswer & j & "、" & objRsSpace!答案1
                                    If Not IsNull(objRsSpace!答案1) Then _
                                        strAnswer = strAnswer & "，" & objRsSpace!答案2
                                    j = j + 1
                                    strAnswer = strAnswer & vbCrLf
                                    Chapter(i, n) = Chapter(i, n) - 1
                                    Level2(i) = Level2(i) - 1
                                    Count(i) = Count(i) - 1
                                    If Not IsNull(objRsSpace!图片) Then _
                                        strTest = strTest & "本题图片：" & objRsSpace!图片
                                End If
                            End If
                    End Select
                Wend
        End Select
    Next
    SeePaper.txtTest = strTest & vbCrLf & vbCrLf & "答案如下：" & vbCrLf & strAnswer
    SeePaper.Show vbModal
    Exit Sub
DealError:
    ShowError "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
End Sub

Private Sub Form_Load()
    On Error GoTo DealError
    Dim strSQL As String, i%
    ThisDBName = "微机原理"
    '创建数据库连接
    Dim objCn As New Connection
    With objCn
        .Provider = "SQLOLEDB"
        strSQL = "User ID=sa;PWD=123;Server=(local);database=" & ThisDBName
        .ConnectionString = strSQL
        .Open                                        '打开连接
    End With
    
    '执行查询，获得判断题数据
    Set objRsJudge = New Recordset
    Set objRsJudge.ActiveConnection = objCn
    objRsJudge.CursorLocation = adUseClient
    objRsJudge.Open "Select * From 判断题"
    Set objRsJudge.ActiveConnection = Nothing
    
     '执行查询，获得单选题数据
    Set objRsSingle = New Recordset
    Set objRsSingle.ActiveConnection = objCn
    objRsSingle.CursorLocation = adUseClient
    objRsSingle.Open "Select * From 单选题"
    Set objRsSingle.ActiveConnection = Nothing
    
     '执行查询，获得多选题数据
    Set objRsMore = New Recordset
    Set objRsMore.ActiveConnection = objCn
    objRsMore.CursorLocation = adUseClient
    objRsMore.Open "Select * From 多选题"
    Set objRsMore.ActiveConnection = Nothing
    
      '执行查询，获得填空题数据
    Set objRsSpace = New Recordset
    Set objRsSpace.ActiveConnection = objCn
    objRsSpace.CursorLocation = adUseClient
    objRsSpace.Open "Select * From 填空题"
    Set objRsSpace.ActiveConnection = Nothing
    
    '执行查询，获得章节信息
    Set objRsChapter = New Recordset
    Set objRsChapter.ActiveConnection = objCn
    objRsChapter.CursorLocation = adUseClient
    strSQL = "select * from 章节"
    objRsChapter.Open strSQL

    '创建“章节”下拉列表
    If objRsChapter.RecordCount > 0 Then
        objRsChapter.MoveFirst
        While Not objRsChapter.EOF
            For i = 0 To 3
                cmbChapter(i).AddItem objRsChapter!名称
                cmbChapter(i).ItemData(cmbChapter(0).NewIndex) = 0
            Next
            objRsChapter.MoveNext
        Wend
    End If
    For i = 0 To 3
        cmbChapter(i).ListIndex = 0
    Next
    Exit Sub
DealError:
    ShowError "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
End Sub

Private Sub txtCount_Change(Index As Integer)
    '计算每小题分数
    If Val(txtCount(Index)) > 0 Then
        If Val(txtCount(Index)) > 0 Then _
            txtAvg(Index) = Val(txtScore(Index)) / Val(txtCount(Index))
    Else
        '在小题数为0时，使分数和小题分为0
        txtAvg(Index) = "0"
        txtScore(Index) = "0"
    End If
    cmdMakePaper.Enabled = False
End Sub

Private Sub txtCount_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii <> vbKeyBack And KeyAscii <> vbKeyDelete Then
        If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
    End If
End Sub

Private Sub txtCount_LostFocus(Index As Integer)
    If txtCount(Index) = "" Then
        MsgBox "小题数不能为0", vbCritical
        txtCount(Index).SetFocus
    End If
End Sub

Private Sub txtLevel0_Change(Index As Integer)
    txtLevel1(Index) = 100 - Val(txtLevel0(Index)) - Val(txtLevel2(Index))
End Sub

Private Sub txtLevel0_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii <> vbKeyBack And KeyAscii <> vbKeyDelete Then
        If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
    End If
End Sub

Private Sub txtLevel0_LostFocus(Index As Integer)
    If txtLevel0(Index) = "" Then txtLevel0(Index) = 0
End Sub

Private Sub txtLevel1_Change(Index As Integer)
    txtLevel2(Index) = 100 - Val(txtLevel0(Index)) - Val(txtLevel1(Index))
End Sub

Private Sub txtLevel1_LostFocus(Index As Integer)
    If txtLevel1(Index) = "" Then txtLevel1(Index) = 0
End Sub

Private Sub txtLevel2_Change(Index As Integer)
    txtLevel1(Index) = 100 - Val(txtLevel0(Index)) - Val(txtLevel2(Index))
End Sub

Private Sub txtLevel2_LostFocus(Index As Integer)
    If txtLevel2(Index) = "" Then txtLevel2(Index) = 0
End Sub

Private Sub txtScale_Change(Index As Integer)
    Dim n%
    '计算剩余题量百分比
    n = Val(txtScale(Index))
    lblRemain(Index) = Val(lblRemain(Index)) + (cmbChapter(Index).ItemData(cmbChapter(Index).ListIndex) - n)
    cmbChapter(Index).ItemData(cmbChapter(Index).ListIndex) = n
    cmdMakePaper.Enabled = False
End Sub

Private Sub txtScale_LostFocus(Index As Integer)
    If txtScale(Index) = "" Then txtScale(Index) = 0
    If Val(lblRemain(Index)) < 0 Then
        MsgBox "该章题量百分比过大，百分比剩余最小为0！", vbCritical
        txtScale(Index).SetFocus
    End If
End Sub

Private Sub txtLevel1_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii <> vbKeyBack And KeyAscii <> vbKeyDelete Then
        If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
    End If
End Sub

Private Sub txtLevel2_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii <> vbKeyBack And KeyAscii <> vbKeyDelete Then
        If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
    End If
End Sub

Private Sub txtScale_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii <> vbKeyBack And KeyAscii <> vbKeyDelete Then
        If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
    End If
End Sub

Private Sub txtScore_Change(Index As Integer)
    Dim n%, i%
    '计算总分
    For i = 0 To 3
        n = n + Val(txtScore(i))
    Next
    lblTotal = "试卷总分：" & n & "分"
    '计算每小题分数
    If Val(txtScore(Index)) > 0 Then
        If Val(txtCount(Index)) > 0 Then _
            txtAvg(Index) = Val(txtScore(Index)) / Val(txtCount(Index))
    Else
        '在分数为0时，使小题数和小题分为0
        txtAvg(Index) = "0"
        txtCount(Index) = "0"
    End If
    cmdMakePaper.Enabled = False
End Sub

Private Sub txtScore_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii <> vbKeyBack And KeyAscii <> vbKeyDelete Then
        If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
    End If
End Sub

Private Sub txtScore_LostFocus(Index As Integer)
    If Val(txtScore(Index)) = 0 Then
        MsgBox "分数不能为0", vbCritical
        txtScore(Index).SetFocus
    End If
End Sub