paperproperty.frm

vb写的试题库生成系统

                    '随即产生一个未选择的试题的记录序号
                    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 4
                                    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 4
                                    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 4
                                    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
                
                Case 4  '简答题
                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 > 60 Then
                            MsgBox "本次生成试题花费时间过长，退出重试！", vbCritical
                            Exit Sub
                        End If
                        n = Int(Rnd * objRsJianda.RecordCount + 1)
                    Loop Until InStr(Selected, "#" & n & "#") = 0
                    Selected = Selected & "#" & n & "#"
                    objRsJianda.MoveFirst
                    objRsJianda.Move n - 1
                    Select Case objRsJianda!难度
                        Case 0
                            If Level0(i) > 0 Then
                                '检查本章试题是否已选够
                                For n = 0 To 4
                                    If cmbChapter(i).ItemData(n) = objRsJianda!章节 Then Exit For
                                Next
                                If Chapter(i, n) > 0 Then
                                 strTest = strTest & j & "、" & objRsJianda!题干 & vbCrLf
                                   strAnswer = strAnswer & j & "、" & objRsJianda!答案
                                    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 & "本题图片：" & objRsJianda!图片
                                End If
                            End If
                        Case 1
                            If Level1(i) > 0 Then
                                '检查本章试题是否已选够
                                For n = 0 To 4
                                    If cmbChapter(i).ItemData(n) = objRsJianda!章节 Then Exit For
                                Next
                                If Chapter(i, n) > 0 Then
                                    strTest = strTest & j & "、" & objRsJianda!题干 & vbCrLf
                                    strAnswer = strAnswer & j & "、" & objRsJianda!答案
                                    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(objRsJianda!图片) Then _
                                        strTest = strTest & "本题图片：" & objRsSpace!图片
                                End If
                            End If
                        Case 2
                            If Level2(i) > 0 Then
                                '检查本章试题是否已选够
                                For n = 0 To 4
                                    If cmbChapter(i).ItemData(n) = objRsJianda!章节 Then Exit For
                               Next
                               If Chapter(i, n) > 0 Then
                                   strTest = strTest & j & "、" & objRsJianda!题干 & vbCrLf
                                    strAnswer = strAnswer & j & "、" & objRsJianda!答案
                                    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(objRsJianda!图片) Then _
                                        strTest = strTest & "本题图片：" & objRsJianda!图片
                                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
    '创建数据库连接
    Set conn = New Connection
     With conn                                      '建立服务器连接
       ' .Provider = "SQLOLEDB"
       ' .ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False" & ThisDBName
       ' .ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=:" & ThisDBName
       
        .Provider = "SQLOLEDB"
        .ConnectionString = "User ID=sa;PWD=;Server=(local);database=" & ThisDBName
        .Open                                         '打开连接
    End With
                                          '打开连接
    
    '执行查询，获得判断题数据
    Set objRsJudge = New Recordset
    Set objRsJudge.ActiveConnection = conn
    objRsJudge.CursorLocation = adUseClient
    objRsJudge.Open "Select * From 判断题"
    Set objRsJudge.ActiveConnection = Nothing
    
     '执行查询，获得单选题数据
    Set objRsSingle = New Recordset
    Set objRsSingle.ActiveConnection = conn
    objRsSingle.CursorLocation = adUseClient
    objRsSingle.Open "Select * From 单选题"
    Set objRsSingle.ActiveConnection = Nothing
    
     '执行查询，获得多选题数据
    Set objRsMore = New Recordset
    Set objRsMore.ActiveConnection = conn
    objRsMore.CursorLocation = adUseClient
    objRsMore.Open "Select * From 多选题"
    Set objRsMore.ActiveConnection = Nothing
    
      '执行查询，获得填空题数据
    Set objRsSpace = New Recordset
    Set objRsSpace.ActiveConnection = conn
    objRsSpace.CursorLocation = adUseClient
    objRsSpace.Open "Select * From 填空题"
    Set objRsSpace.ActiveConnection = Nothing
    
    '执行查询，获得简答题数据
    Set objRsJianda = New Recordset
    Set objRsJianda.ActiveConnection = conn
    objRsJianda.CursorLocation = adUseClient
    objRsJianda.Open "Select * From 简答题"
    Set objRsJianda.ActiveConnection = Nothing
    
    '执行查询，获得章节信息
    Set objRsChapter = New Recordset
    Set objRsChapter.ActiveConnection = conn
    objRsChapter.CursorLocation = adUseClient
    strSQL = "select * from 章节"
    objRsChapter.Open strSQL

    '创建“章节”下拉列表
    If objRsChapter.RecordCount > 0 Then
        objRsChapter.MoveFirst
        While Not objRsChapter.EOF
            For i = 0 To 4
                cmbChapter(i).AddItem objRsChapter!名称
                cmbChapter(i).ItemData(cmbChapter(0).NewIndex) = 0
            Next
            objRsChapter.MoveNext
        Wend
    End If
    For i = 0 To 4
        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)