paperproperty.frm

vb写的试题库生成系统

         Width           =   1350
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         Caption         =   "总分"
         Height          =   180
         Left            =   1290
         TabIndex        =   31
         Top             =   360
         Width           =   360
      End
      Begin VB.Label Label10 
         AutoSize        =   -1  'True
         Caption         =   "容易"
         Height          =   180
         Left            =   5745
         TabIndex        =   11
         Top             =   360
         Width           =   360
      End
      Begin VB.Label Label9 
         AutoSize        =   -1  'True
         Caption         =   "一般"
         Height          =   180
         Left            =   4860
         TabIndex        =   10
         Top             =   360
         Width           =   360
      End
      Begin VB.Label Label8 
         AutoSize        =   -1  'True
         Caption         =   "难"
         Height          =   180
         Left            =   4065
         TabIndex        =   9
         Top             =   360
         Width           =   180
      End
      Begin VB.Label Label7 
         AutoSize        =   -1  'True
         Caption         =   "分/题"
         Height          =   180
         Left            =   3030
         TabIndex        =   8
         Top             =   360
         Width           =   450
      End
      Begin VB.Label Label6 
         AutoSize        =   -1  'True
         Caption         =   "小题数"
         Height          =   180
         Left            =   2100
         TabIndex        =   7
         Top             =   360
         Width           =   540
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         Caption         =   "填空题"
         Height          =   180
         Left            =   405
         TabIndex        =   6
         Top             =   1725
         Width           =   540
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "多选题"
         Height          =   180
         Left            =   405
         TabIndex        =   5
         Top             =   1365
         Width           =   540
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "单选题"
         Height          =   180
         Left            =   405
         TabIndex        =   4
         Top             =   1005
         Width           =   540
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "判断题"
         Height          =   180
         Left            =   405
         TabIndex        =   3
         Top             =   645
         Width           =   540
      End
   End
   Begin VB.Label Label23 
      AutoSize        =   -1  'True
      Caption         =   "填空题"
      Height          =   180
      Left            =   720
      TabIndex        =   69
      Top             =   2400
      Width           =   540
   End
End
Attribute VB_Name = "PaperProperty"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim objRsJudge As Recordset, objRsSingle As Recordset, objRsMore As Recordset, objRsJianda As Recordset
Dim objRsSpace As Recordset, objRsChapter As Recordset
Private Sub cmbChapter_Click(Index As Integer)
    txtScale(Index) = cmbChapter(Index).ItemData(cmbChapter(Index).ListIndex)
End Sub

Private Sub cmdExit_Click()
    Unload Me               '关闭窗体
End Sub

Private Sub cmdAnalyse_Click()
    On Error GoTo DealError
    '分析章节中的题数分配
    Dim News, i%, j%, strFilter$, Chapter%(4, 2), k%
    News = Array("判断题", "单选题", "多选题", "填空题", "简答题")
    For i = 0 To 4
        If Val(txtScore(i)) <> 0 And Val(lblRemain(i)) <> 0 Then
            MsgBox News(i) & "试题剩余" & lblRemain(i) & "%未分配", vbCritical
            txtScale(i).SetFocus
            Exit Sub
        End If
    Next
    '检查章节题量分配是否有效
    If objRsChapter.RecordCount <= 0 Then Exit Sub
    For i = 0 To 4
        If Val(txtScore(i)) <> 0 Then
            For j = 0 To cmbChapter(i).ListCount - 1
                objRsChapter.MoveFirst
                objRsChapter.Find "名称='" & cmbChapter(i).List(j) & "'"
                strFilter = "章节=" & objRsChapter!编号
                Select Case i
                    Case 0  '检查判断题题量分配是否有效
                        objRsJudge.Filter = strFilter
                        If objRsJudge.RecordCount < Int(cmbChapter(i).ItemData(j) * _
                            txtCount(i) / 100) Then
                            MsgBox "<" & News(i) & "><" & objRsChapter!名称 & ">中只有<" _
                                & objRsJudge.RecordCount & ">道试题，小题百分比最多<" _
                                & Int(objRsJudge.RecordCount / Val(txtCount(i)) * 100) _
                                & ">", vbCritical
                                cmbChapter(i).ListIndex = j
                                Exit Sub
                        End If
                        '小题数通过检验，统计各类难度试题数量
                        For k = 0 To 2
                            objRsJudge.Filter = strFilter & " and 难度=" & k
                            Chapter(i, k) = Chapter(i, k) + objRsJudge.RecordCount
                        Next
                    Case 1  '检查单选题题量分配是否有效
                        objRsSingle.Filter = strFilter
                        If objRsSingle.RecordCount < Int(cmbChapter(i).ItemData(j) * _
                            txtCount(i) / 100) Then
                            MsgBox "<" & News(i) & "><" & objRsChapter!名称 & ">中只有<" _
                                & objRsSingle.RecordCount & ">道试题，小题百分比最多<" _
                                & Int(objRsSingle.RecordCount / Val(txtCount(i)) * 100) _
                                & ">", vbCritical
                                cmbChapter(i).ListIndex = j
                                Exit Sub
                        End If
                        '小题数通过检验，统计各类难度试题数量
                        For k = 0 To 2
                            objRsSingle.Filter = strFilter & " and 难度=" & k
                            Chapter(i, k) = Chapter(i, k) + objRsSingle.RecordCount
                        Next
                    Case 2  '检查多选题题量分配是否有效
                        objRsMore.Filter = strFilter
                        If objRsMore.RecordCount < Int(cmbChapter(i).ItemData(j) * _
                            txtCount(i) / 100) Then
                            MsgBox "<" & News(i) & "><" & objRsChapter!名称 & ">中只有<" _
                                & objRsMore.RecordCount & ">道试题，小题百分比最多<" _
                                & Int(objRsMore.RecordCount / Val(txtCount(i)) * 100) _
                                & ">", vbCritical
                                cmbChapter(i).ListIndex = j
                                Exit Sub
                        End If
                        '小题数通过检验，统计各类难度试题数量
                        For k = 0 To 2
                            objRsMore.Filter = strFilter & " And 难度 = " & k
                            Chapter(i, k) = Chapter(i, k) + objRsMore.RecordCount
                        Next
                        
                    Case 3  '检查填空题题量分配是否有效
                        objRsSpace.Filter = strFilter
                        If objRsSpace.RecordCount < Int(cmbChapter(i).ItemData(j) * _
                            txtCount(i) / 100) Then
                            MsgBox "<" & News(i) & "><" & objRsChapter!名称 & ">中只有<" _
                                & objRsSpace.RecordCount & ">道试题，小题百分比最多<" _
                                & Int(objRsSpace.RecordCount / Val(txtCount(i)) * 100) _
                                & ">", vbCritical
                                cmbChapter(i).ListIndex = j
                                Exit Sub
                        End If
                        '小题数通过检验，统计各类难度试题数量
                        For k = 0 To 2
                            objRsSpace.Filter = strFilter & " and 难度=" & k
                            Chapter(i, k) = Chapter(i, k) + objRsSpace.RecordCount
                        Next
                    Case 4  '检查简答题题量分配是否有效
                        objRsJianda.Filter = strFilter
                        If objRsJianda.RecordCount < Int(cmbChapter(i).ItemData(j) * _
                            txtCount(i) / 100) Then
                            MsgBox "<" & News(i) & "><" & objRsChapter!名称 & ">中只有<" _
                                & objRsJianda.RecordCount & ">道试题，小题百分比最多<" _
                                & Int(objRsJianda.RecordCount / Val(txtCount(i)) * 100) _
                                & ">", vbCritical
                                cmbChapter(i).ListIndex = j
                                Exit Sub
                        End If
                        '小题数通过检验，统计各类难度试题数量
                        For k = 0 To 2
                            objRsJianda.Filter = strFilter & " and 难度=" & k
                            Chapter(i, k) = Chapter(i, k) + objRsJianda.RecordCount
                        Next
                End Select
            Next
        End If
    Next
    '按难度检查题量分配是否合理
    For i = 0 To 3
        '检查难度属于“难”的题题量分配是否有效
        If Chapter(i, 0) < Int(Val(txtCount(i)) * txtLevel0(i) / 100) Then
            MsgBox News(i) & "题库中难度属于“难”的题只有<" _
                & Chapter(i, 0) & ">道，难度百分比最大可为<" _
                & Int(Chapter(i, 0) / Val(txtCount(i)) * 100) _
                & ">", vbCritical
                txtLevel0(i).SetFocus
                Exit Sub
        End If
       '检查难度属于“一般”的题题量分配是否有效
        If Chapter(i, 1) < Int(Val(txtCount(i)) * txtLevel1(i) / 100) Then
            MsgBox News(i) & "题库中难度属于“一般”的题只有<" _
                & Chapter(i, 1) & ">道，难度百分比最大可为<" _
                & Int(Chapter(i, 1) / Val(txtCount(i)) * 100) _
                & ">", vbCritical
                txtLevel1(i).SetFocus
                Exit Sub
        End If
        '检查难度属于“容易”的题题量分配是否有效
        If Chapter(i, 2) < Int(Val(txtCount(i)) * txtLevel2(i) / 100) Then
            MsgBox News(i) & "题库中难度属于“容易”的题只有<" _
                & Chapter(i, 2) & ">道，难度百分比最大可为<" _
                & Int(Chapter(i, 2) / Val(txtCount(i)) * 100) _
                & ">", vbCritical
                txtLevel2(i).SetFocus
                Exit Sub
        End If
    Next
    MsgBox "试卷参数设置正确，可以生成试卷！", vbInformation
    '取消各个记录集的过虑设置
    objRsSpace.Filter = ""
    objRsMore.Filter = ""
    objRsSingle.Filter = ""
    objRsJudge.Filter = ""
    objRsJianda.Filter = ""
    cmdMakePaper.Enabled = True
    Exit Sub
DealError:
    ShowError "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
End Sub

Private Sub cmdMakePaper_Click()
    On Error GoTo DealError
    Randomize Timer
    Dim Level0%(4), Level1%(4), Level2%(4), i%, n%, strTest$, strAnswer$
    Dim Count%(4), Selected$, Chapter%(), Ok, Abcd, more%, doTime As Long
    doTime = Timer   '开始计算生成试题时间
    Abcd = Array("A", "B", "C", "D")
    ReDim Chapter(4, cmbChapter(0).ListCount - 1)
    '计算各类题型的难度小题数
    For i = 0 To 4
        n = Val(txtCount(i))
        Count(i) = n
        Level0%(i) = Int(Val(txtLevel0(i)) * n / 100)
        Level1%(i) = Int(Val(txtLevel1(i)) * n / 100)
        Level2%(i) = Int(Val(txtLevel2(i)) * n / 100)
        If Level0%(i) + Level1%(i) + Level2%(i) <> n Then _
            Level1%(i) = n - Level0%(i) - Level2%(i)
    Next
 '   For i = 0 To 4
  '      cmbChapter(i).ItemData(0) = 10
   '     cmbChapter(i).ItemData(1) = 20
    '    cmbChapter(i).ItemData(2) = 30
     '   cmbChapter(i).ItemData(3) = 20
      '  cmbChapter(i).ItemData(3) = 20
    'Next
    '计算各章节各类题型的小题数
    For i = 0 To 4
        For j = 0 To cmbChapter(0).ListCount - 1
            Chapter(i, j) = Int(cmbChapter(i).ItemData(j) * Val(txtCount(i)) / 100)
        Next
        n = 0