paperproperty.frm

很不错的哦!!! !!! !!! !!! !!!1

                            Leve10(i) = Leve10(i) - 1
                            Count(i) = Count(i) - 1
                            If Not IsNull(objRsMore!图片) Then strTest = strTest & "本题图片：" & objRsMore!图片
                            End If
                            End If
        Case 1
              If Leve11(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
             Leve11(i) = Leve11(i) - 1
             Count(i) = Count(i) - 1
             If Not IsNull(objRsMore!图片) Then strTest = strTest & "本题图片：" & objRsMore!图片
             End If
             End If
       Case 2
              If leve12(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
             leve12(i) = leve12(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 Leve10(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
                         Leve10(i) = Leve10(i) - 1
                         Count(i) = Count(i) - 1
                         If Not IsNull(objRsSpace!图片) Then _
                            strTest = strTest & "本题图片：" & objRsSpace!图片
                         End If
                         End If
                     Case 1
                        If Leve11(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
                         Leve11(i) = Leve11(i) - 1
                         Count(i) = Count(i) - 1
                         If Not IsNull(objRsSpace!图片) Then _
                            strTest = strTest & "本题图片：" & objRsSpace!图片
                         End If
                         End If
                    Case 2
                        If leve12(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
                         leve12(i) = leve12(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 strSQ As String, i%
ThisDBName = "微机原理"
'创建数据库连接
Dim objCn As New Collection
With objCn
.provider = "SQLOLEDB"
strSQL = "User ID=sa;PWD=123;Sever=(local);database=" & ThisDBName
.ConnectionString = strSQL
.Open                              '打开连接
End With
'执行查询，获得判断题数据
Set objRsJudge = New Recordset
Set objRsJudge.ActiveConnection = objCn
objRsJudge.CoursorLocation = 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))
   End If
   cmdMakePaper.Enabled = False
End Sub

Private Sub txtCount_KeyPress(Index As Integer, KeyAscii As Integer)
 If KeyAscii <> vbKeyBack And KeyAscill <> 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 txtLeve10_Change(Index As Integer)
 txtLeve11(Index) = 100 - Val(txtLeve10(Index)) - Val(txtLeve12(Index))
End Sub

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

Private Sub txtLeve10_LostFocus(Index As Integer)
 If txtLeve10(Index) = "" Then txtLeve10(Index) = 0
End Sub

Private Sub txtLeve11_Change(Index As Integer)
  txtLeve12 = 100 - Val(txtLeve10(Index)) - Val(txtLeve11(Index))
End Sub

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

Private Sub txtLeve11_LostFocus(Index As Integer)
  If txtLeve11(Index) = "" Then txtLeve11(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
  cmbMakePaper.Enabled = False
End Sub

Private Sub txtScale_KeyPress(Index As Integer, KeyAscii As Integer)
 If KeyAscii <> vbKeyBack And KeyAscill <> vbKeyDelete Then
     If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
  End If
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 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 KeyAscill <> 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