autofrmexam.frm

这是我们公司的题库管理系统,用VB实现,可以进行试题制作,编辑、试卷制作、试卷生成和试卷打印(A3/和A4)

         TabIndex        =   8
         Top             =   480
         Width           =   1215
      End
      Begin VB.Line Line1 
         BorderColor     =   &H000000FF&
         X1              =   -70080
         X2              =   -69600
         Y1              =   1680
         Y2              =   1680
      End
      Begin VB.Line Line3 
         BorderColor     =   &H000000FF&
         X1              =   -70080
         X2              =   -69600
         Y1              =   1800
         Y2              =   1800
      End
      Begin VB.Line Line4 
         BorderColor     =   &H000000FF&
         X1              =   -70080
         X2              =   -69600
         Y1              =   1920
         Y2              =   1920
      End
   End
   Begin VB.Label Label2 
      Caption         =   "当前课程："
      Height          =   255
      Left            =   1320
      TabIndex        =   13
      Top             =   120
      Width           =   975
   End
   Begin VB.Label Label3 
      Caption         =   "Label3"
      Height          =   255
      Left            =   2760
      TabIndex        =   12
      Top             =   120
      Width           =   3135
   End
End
Attribute VB_Name = "AutoFrmExam"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Auto_Num As Integer
Dim m As Byte
Private Sub Cmd_Add_Click()
  '判断是否选择了题型
  If Lst_Name.Text = "" Then
    MsgBox "请选择要添加的题型！", vbOKOnly + 64, "信息"
    Lst_Name.SetFocus
    Exit Sub
  End If
  '判断是否输入了选择的题型的题量
  If TxtNumber.Text = "" Or Not IsNumeric(TxtNumber.Text) Then
    MsgBox "请输入所选择的题型号的题量！（必须是数字）", vbOKOnly + 48, "警告"
    TxtNumber.SetFocus
    Exit Sub
  End If
  '判断是否已经添加了选择的题型
  m = 0
  Do While m < Lst_Number.ListCount
    If Lst_Name.Text = Lst_Number.List(m) Then
      MsgBox "此题型已经添加，不能再添加此题型！", vbOKOnly + 48, "警告"
      Lst_Name.SetFocus
      Exit Sub
    Else
      m = m + 1
    End If
  Loop
  MyClass.Load_Class_ByUpper (CurClass.ClassId)
  'Arr_ClassId 保存了此课程所有的章节
  'frmclassman.num保存了章节数
  m = 0
  Auto_Num = 0
  Do While m <= FrmclassMan.num
    Auto_Num = Auto_Num + MyExam.ExamCount(Arr_ClassId(m), _
        Trim(Lst_Name.Text))
    m = m + 1
  Loop
  If Auto_Num < TxtNumber.Text Then
    MsgBox "你输入的题量过大,题库中没有足够的题量！" _
       & Chr(10) & Chr(13) & "建议使用 <=" & Auto_Num & " 的数。"
    TxtNumber.Text = ""
    TxtNumber.SetFocus
    Exit Sub
  End If
  '开始添加新题型
  Lst_Number.AddItem Lst_Name.Text
  List1.AddItem TxtNumber.Text
  Lst_Name.SetFocus
  TxtNumber.Text = ""
End Sub
Private Sub Cmd_Cancel_Click()
  Unload Me
End Sub
Private Sub Cmd_Del_Click()
  If Lst_Number.Text = "" Then
    MsgBox "请选择要删除的已经添加的题型", vbOKOnly + 64, "信息"
    Lst_Number.SetFocus
    Exit Sub
  End If
  Lst_Number.RemoveItem (Lst_Number.ListIndex)
  List1.RemoveItem (m)
End Sub

Private Sub Cmd_Modi_Click()
  
  If Lst_Number.Text = "" Then
    MsgBox "请选择要修改的题型！", vbOKOnly + 64, "信息"
    Lst_Number.SetFocus
    Exit Sub
  End If
  '判断是否输入了选择的题型的题量
  If TxtNumber.Text = "" Or Not IsNumeric(TxtNumber.Text) Then
    MsgBox "请输入所选择的题型号的题量！（必须是数字）", vbOKOnly + 48, "警告"
    TxtNumber.SetFocus
    Exit Sub
  End If
  '判断题库中是否有足够的题目
  MyClass.Load_Class_ByUpper (CurClass.ClassId)
  'Arr_ClassId 保存了此课程所有的章节
  'frmclassman.num保存了章节数
  m = 0
  Auto_Num = 0
  Do While m <= FrmclassMan.num
    Auto_Num = Auto_Num + MyExam.ExamCount(Arr_ClassId(m), _
        Trim(Lst_Number.Text))
        MsgBox Auto_Num
    m = m + 1
  Loop
  If Auto_Num < TxtNumber.Text Then
    MsgBox "你输入的题量过大,题库中没有足够的题量！" _
       & Chr(10) & Chr(13) & "建议使用 <=" & Auto_Num & " 的数。"
    TxtNumber.Text = ""
    TxtNumber.SetFocus
    Exit Sub
  End If
  List1.List(m) = TxtNumber.Text
  TxtNumber.Text = ""
  Lst_Name.SetFocus
End Sub

Private Sub Cmd_Ok_Click()
  Dim Number As Long
  Dim k As Long
  Dim n As Integer
  Dim p As Integer
  If Trim(TxtPaperName.Text) = "" Then
      MsgBox "试卷名称不能为空", vbOKOnly + 48, "警告"
      TxtPaperName.SetFocus
      Exit Sub
  End If
  If Trim(TxtHeader.Text) = "" Then
      MsgBox "试卷标题不能为空", vbOKOnly + 48, "警告"
      TxtHeader.SetFocus
      Exit Sub
  End If
  If Lst_Number.ListCount = 0 Then
    MsgBox "没有选择题型！", vbOKOnly + 64, "信息"
    Exit Sub
  End If
  '添加了一份试卷
  With MyPaper
      .PaperName = MakeStr(TxtPaperName.Text)
      .Header = MakeStr(TxtHeader.Text)
      .UserName = CurUser.UserName
      .Describe = MakeStr(TxtPaperDes.Text)
      .Classname = CurClass.Classname
      .Insert
      FrmExamRep.Adodc1.Refresh
  End With
  '选择这份试卷
  With CurPaper
    .PaperId = MyPaper.PaperId
    .PaperName = MyPaper.PaperName
    .UserName = MyPaper.UserName
    .Header = MyPaper.Header
    .Describe = MyPaper.Describe
  End With
  '开始为试卷添加题目
  MyClass.Load_Class_ByUpper (CurClass.ClassId)
  'Arr_ClassId 保存了此课程所有的章节号
  'frmclassman.num保存了章节数
  Number = MyExam.Counts
  '加入List1.list(0)个Lst_number.list(0)题型的试题
  For p = 0 To Lst_Number.ListCount - 1 Step 1
    For m = 1 To List1.List(p) Step 1
      Randomize
      k = Int(Rnd(3) * Number + 1) '产生一个1---NUMBER的数,以得到一个ExamId
      n = 0
      Do While n <= FrmclassMan.num
        '看这个题目是否是这门课程章节中的题目,且题型是Lst_number.list(0)的题目
        If MyExam.In_Db3(k, Arr_ClassId(n), Lst_Number.List(p)) = True Then
           '看是不是已经加入到了试卷中,在则不要加入,不在则加入
           If MyQuestionP.In_DB(CurPaper.PaperId, k) = True Then
             Exit Do
           Else
             '加入这道试题
             MyQuestionP.PaperId = CurPaper.PaperId
             MyQuestionP.ExamId = MyExam.ExamId
             MyQuestionP.Insert
             FrmExamRep.AdcPaper.Refresh
             Exit Do
           End If
         Else
           n = n + 1
         End If
      Loop
    Next m
  Next p
  MsgBox "试卷已经生成,请浏览试卷和答案"
  
  FrmExamRep.SSTab1.Tab = 3
  FrmExamRep.Show 1
  Unload Me
End Sub

Private Sub Form_Load()
  Label3.Caption = CurClass.Classname
  lst_Name_DblClick '加入所有题型
  Lst_Number.Clear
  List1.Clear
  TxtNumber.Text = ""
  UserName.Caption = CurUser.UserName
  Classname.Caption = CurClass.Classname
End Sub

Private Sub lst_Name_DblClick()
  Dim j As Integer
  j = 0
  Lst_Name.Clear
  Lst_Number.Clear
  MyTitle.Get_ArrTitleName (CurClass.ClassId)
  Do While j <= FrmTitleMan.num
    Lst_Name.AddItem Arr_TitleName(j), j
    j = j + 1
  Loop
End Sub

Private Sub Lst_Number_Click()
  m = Lst_Number.ListIndex
End Sub