frmexamrep.frm

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

  If MyQuestionP.In_Db3(MyPaper.PaperId) = True Then
    If MsgBox("此试卷中有试题,真的要删除吗？", vbOKCancel + 48, "警告") = vbOK Then
       MyQuestionP.Delete2 (MyPaper.PaperId)
       MyPaper.Delete (MyPaper.PaperId)
       CurPaper.PaperId = -1
       AdcPaper.Refresh
       MsgBox "试卷删除成功", vbOKOnly + 64, "信息"
       Adodc1.Refresh
    End If
  Else
    MyPaper.Delete (MyPaper.PaperId)
    MsgBox "删除成功"
    Adodc1.Refresh
    
  End If
End Sub

Private Sub Cmd_DelE_Click()
  If Cmd_DelE.Caption = "删除试卷题目" Then
    SSTab2.TabEnabled(1) = True
    SSTab2.Tab = 1 '显示DATADrid2
    SSTab2.TabEnabled(0) = False
    Cmd_AddE.Enabled = False
    Cmd_DelE.Caption = "删除题目"
    Cmd_Cancel.Caption = "取消删除"
    List1.Enabled = False
    DataGrid2.SetFocus
  Else
    '1 必须选择要修改的试卷
    If CurPaper.PaperId < 1 Then
      MsgBox "请选择要修改的试卷", vbOKOnly + 48, "警告"
      SSTab1.Tab = 1
      Exit Sub
    End If
    '2 必须选择试卷中要删除的题目
    If AdcPaper.Recordset.EOF = True Or AdcPaper.Recordset.BOF = True Then
      MsgBox "请选择试卷中要删除的题目", vbOKOnly + 48, "警告"
      Exit Sub
    End If
    '开始删除
    MyQuestionP.Delete (MyQuestionP.Id)
    AdcPaper.Refresh
    DataGrid2.Refresh
  End If
End Sub

Private Sub Cmd_Modi_Paper_Click()
  If Cmd_Modi_Paper.Caption = "修改试卷" Then
    Cmd_Add_Paper.Enabled = False
    Cmd_Del_Paper.Enabled = False
    Command11.Enabled = True
    Cmd_Modi_Paper.Caption = "确  定"
    TxtPaperName.Enabled = True
    TxtHeader.Enabled = True
    TxtPaperDes.Enabled = True
  Else
  
  If DataList1.Text = "" Then
    MsgBox "请选择要修改的试卷", vbOKOnly + 48, "警告"
    Exit Sub
  End If
  If Trim(TxtPaperName.Text) = "" Then
    MsgBox "试卷名称不能为空", vbOKOnly + 48, "警告"
    Exit Sub
  End If
  If Trim(TxtHeader.Text) = "" Then
    MsgBox "试卷标题不能为空", vbOKOnly + 48, "警告"
    Exit Sub
  End If
  
  With MyPaper
    .PaperName = MakeStr(TxtPaperName.Text)
    .Header = MakeStr(TxtHeader.Text)
    .UserName = CurUser.UserName
    .Describe = MakeStr(TxtPaperDes.Text)
    .Update (.PaperId)
    Adodc1.Refresh
  End With
  MsgBox "修改成功"
  Command11.Enabled = False
  Cmd_Modi_Paper.Caption = "修改试卷"
  Cmd_Add_Paper.Enabled = True
  Cmd_Del_Paper.Enabled = True
  TxtPaperName.Enabled = False
  TxtHeader.Enabled = False
  TxtPaperDes.Enabled = False
  End If
End Sub

Private Sub Cmd_SaveE_Click()
  If CurPaper.PaperId < 1 Then
    MsgBox "请选择一份试卷！", vbOKOnly + 48, "警告"
    Exit Sub
  End If
  If RichBox.TextRTF = "" Then
    MsgBox "试卷或答案为空，建议为试卷添加题目", vbOKOnly + 64, "信息"
    Exit Sub
  End If
  ComDialog1.InitDir = "c:\"
  ComDialog1.Filter = "Word文档(*.rtf)|*.rtf"
  If k = 0 Then
     ComDialog1.FileName = CurPaper.PaperName
  Else
     ComDialog1.FileName = CurPaper.PaperName & "参考答案"
  End If
  ComDialog1.ShowSave
  RichBox.SaveFile ComDialog1.FileName, 0
  
End Sub

'选择要修改的试卷,以进行添加删除题目,保存在CurPaper变量中
Private Sub Cmd_sel_Paper_Click()
  If DataList1.Text = "" Then
    MsgBox "请选择试卷", vbOKOnly + 48, "警告"
    Exit Sub
  End If
  With CurPaper
    .PaperId = MyPaper.PaperId
    .PaperName = MyPaper.PaperName
    .UserName = MyPaper.UserName
    .Header = MyPaper.Header
    .Describe = MyPaper.Describe
    AdcPaper.RecordSource = "SELECT * FROM QuestionP WHERE PaperId=" + Trim(Str(CurPaper.PaperId))
    AdcPaper.Refresh
    '在这里，adcpaper.redordsource.field(2)得到了所有的题目的试题号
    Frame9.Caption = "试卷共有 " & AdcPaper.Recordset.RecordCount & " 题"
  End With
End Sub
'用来显示试卷中所有的题目
Private Sub CmdExams_Click()
  If CurPaper.PaperId < 1 Then
    MsgBox "请选择试卷！", vbOKOnly + 64, "信息"
    SSTab1.Tab = 1
    Exit Sub
  End If
  '加入试卷名称和标题
  k = 0
  RichBox.TextRTF = ""
  RichBox.SelStart = 0
  RichText.TextRTF = CurPaper.PaperName & _
  Chr(10) & Chr(13) & CurPaper.Header & Chr(10) & Chr(13)
  RichText.SelStart = 0
  RichText.SelLength = Len(RichText.TextRTF)
  RichBox.SelRTF = RichText.SelRTF & Chr(10) & Chr(13)
  
  '加入所有的试题
  '1 得到试卷所有的试题号,保存在Arr_ExamId()中
       'numexamid保存了题目的数量
  MyQuestionP.Load_Exams (CurPaper.PaperId)
  '2 得到试卷所有的题型名frmtitleman.num保存了题型数
        ',arr_titlename()保存了题型名
  MyTitle.Get_ArrTitleName (CurClass.ClassId)
  m = 0
  num = 0
  n = 1
  Do While m <= FrmTitleMan.num
    Select Case m
      Case 0:
          RichText.TextRTF = Chr(13) & "一、" & Arr_TitleName(m) & Chr(10) & Chr(13)
          MainQuestion
        Case 1:
          RichText.TextRTF = Chr(13) & "二、" & Arr_TitleName(m) & Chr(10) & Chr(13)
          MainQuestion
        Case 2:
          RichText.TextRTF = Chr(13) & "三、" & Arr_TitleName(m) & Chr(10) & Chr(13)
          MainQuestion
        Case 3:
          RichText.TextRTF = Chr(13) & "四、" & Arr_TitleName(m) & Chr(10) & Chr(13)
          MainQuestion
        Case 4:
          RichText.TextRTF = Chr(13) & "五、" & Arr_TitleName(m) & Chr(10) & Chr(13)
          MainQuestion
        Case 5:
          RichText.TextRTF = Chr(13) & "六、" & Arr_TitleName(m) & Chr(10) & Chr(13)
          MainQuestion
        Case 6:
          RichText.TextRTF = Chr(13) & "七、" & Arr_TitleName(m) & Chr(10) & Chr(13)
          MainQuestion
        Case 7:
          RichText.TextRTF = Chr(13) & "八、" & Arr_TitleName(m) & Chr(10) & Chr(13)
          MainQuestion
        Case 8:
          RichText.TextRTF = Chr(13) & "九、" & Arr_TitleName(m) & Chr(10) & Chr(13)
          MainQuestion
        Case 9:
          RichText.TextRTF = Chr(13) & "十、" & Arr_TitleName(m) & Chr(10) & Chr(13)
          MainQuestion
        Case Else:
          RichText.TextRTF = Chr(13) & "其他、" & Arr_TitleName(m) & Chr(10) & Chr(13)
          MainQuestion
    End Select
    m = m + 1
  Loop
End Sub

Private Sub Command11_Click()
  Cmd_Add_Paper.Enabled = True
  Cmd_Modi_Paper.Enabled = True
  Cmd_Del_Paper.Enabled = True
  Cmd_Add_Paper.Caption = "添加试卷"
  Cmd_Modi_Paper.Caption = "修改试卷"
  TxtPaperName.Enabled = False
  TxtHeader.Enabled = False
  TxtPaperDes.Enabled = False
End Sub

Private Sub DataGrid1_Click()
  If AdcExams.Recordset.EOF = False And AdcExams.Recordset.BOF = False Then
    MyExam.GetInfo (AdcExams.Recordset.Fields(0))
  Else
    Exit Sub
  End If
  '显示章节名
  ComClassName.Text = MyClass.GetName(Trim(MyExam.ClassId)) '2
  '显示题型名
  ComTitleName.Text = MyExam.TitleName '3
End Sub
Private Sub DataGrid2_Click()
  If AdcPaper.Recordset.EOF = False And AdcPaper.Recordset.BOF = False Then
    MyQuestionP.GetInfo (AdcPaper.Recordset.Fields(0))
    AdcExamT.RecordSource = "SELECT * FROM Exams where ExamId=" + Trim(Str(MyQuestionP.ExamId))
    AdcExamT.Refresh
    RichTitleName.TextRTF = AdcExamT.Recordset.Fields(3)
    RichAnswer.TextRTF = AdcExamT.Recordset.Fields(4)
    '在MyExam中保存了下面三个信息
    MyExam.GetInfo (MyQuestionP.ExamId)
    '显示章节名
    ComClassName.Text = MyClass.GetName(Trim(MyExam.ClassId))
    '显示题型名
    ComTitleName.Text = MyExam.TitleName
    '显示描述
    TxtDes.Text = MyExam.Describe
    Else
      Exit Sub
  End If
End Sub

Private Sub DataList1_Click()
  If DataList1.Text = "" Then
    Exit Sub
  End If
  With MyPaper
    .GetInfo (DataList1.Text)
    TxtPaperName.Text = .PaperName
    UserName.Caption = .UserName
    TxtHeader.Text = .Header
    TxtPaperDes.Text = .Describe
    Classname.Caption = .Classname
  End With
End Sub

Private Sub Form_Load()
  Me.Top = 0 '设置窗体上边界位置
  Me.Left = 0 '设置窗体左边界位置
  Me.Width = Screen.Width '设置窗体宽度为屏幕宽度
  Me.Height = Screen.Height '设置窗体高度为屏幕高度
  UserName.Caption = ""
  '选择了一份试卷
  SSTab1.Tab = 1
  DataList1_Click
  Cmd_sel_Paper_Click
  
  SSTab2.TabEnabled(1) = False
  SSTab2.Tab = 0
  List1.Clear
  DataGrid1.AllowRowSizing = False '不能修改行高
  DataGrid2.AllowRowSizing = False
  lblClassName.Caption = CurClass.Classname '显示课程名
  lblUserName.Caption = CurUser.UserName '显示用户名
  '将课程中所有的章节显示到LIST1列表中和 ComClassName 中
  j = 0
  MyClass.Load_Class_ByUpper (CurClass.ClassId)
  Do While j <= FrmclassMan.num
    List1.AddItem Arr_ClassName(j), j
    ComClassName.AddItem Arr_ClassName(j), j
    j = j + 1
  Loop
  If j = 0 Then
    MsgBox "为了管理的方便：" & Chr(10) & Chr(13) & _
           "请为你的这门课程添加一个章节！", vbOKOnly + 48, "警告"
    With FrmClassedit
      .UpperName = CurClass.Classname
      .Caption = "添 加 章 节"
      .Label3 = "章节名："
      .Modify = 6
      .Show 1
    End With
    MyClass.Load_Class_ByUpper (CurClass.ClassId)
    'Arr_ClassId存放了所有的子课程号
    'Arr_ClassName存放了所有的子课程名
    Do While j <= FrmclassMan.num
        List1.AddItem Arr_ClassName(j), j
        ComClassName.AddItem Arr_ClassName(j), j
        j = j + 1
    Loop
  End If
  '将课程中所有的题型添加到ComTitleName列表中
  j = 0
  MyTitle.Get_ArrTitleName (CurClass.ClassId)
  Do While j <= FrmTitleMan.num
    ComTitleName.AddItem Arr_TitleName(j), j
    j = j + 1
  Loop
  If j = 0 Then
    MsgBox "请先进行题型设置！", vbOKOnly + 48, "警告"
    Unload Me
    FrmTitleMan.Show 1
  End If
  List1.Selected(0) = True
  '将课程中所选章节的题目全部显示到DataGrid1列表中
  MyClass.GetInfo (Trim(List1.List(0)))
  AdcExams.RecordSource = "select * from Exams Where ClassId=" + Trim(MyClass.ClassId)
  AdcExams.Refresh
  Frame2.Caption = "总共有 " & AdcExams.Recordset.RecordCount & " 道题目"
  '只显示用户所管理课程的试卷
  Adodc1.RecordSource = "SELECT * FROM Papers WHERE ClassName='" + Trim(CurClass.Classname) + "'"
  Adodc1.Refresh
End Sub
'当章击 List1 时,将所选章节的全部题目显示到 DataGrid 列表中.
Private Sub List1_Click()
  ComClassName.Text = Trim(List1.Text)
  MyClass.GetInfo (Trim(List1.Text))
  AdcExams.RecordSource = "select * from Exams Where ClassId=" + Trim(MyClass.ClassId)
  AdcExams.Refresh
  Frame2.Caption = "共有 " & AdcExams.Recordset.RecordCount & " 道题可添加"
End Sub

Private Sub Main1()
  RichText.SelStart = 0
          RichText.SelLength = Len(RichText.SelRTF)
          RichBox.SelStart = Len(RichBox.TextRTF)
          RichBox.SelRTF = RichText.SelRTF
          Do While num <= numExamId
            Adodc2.RecordSource = "SELECT Answer FROM Exams WHERE ExamId=" _
             + Trim(Str(Arr_ExamId(num))) + " And TitleName =  '" _
             + Trim(Arr_TitleName(m)) + "'"
            Adodc2.Refresh
            If Adodc2.Recordset.EOF = False And Adodc2.Recordset.BOF = False Then
              RichText.TextRTF = Chr(13) & n & "、"
              n = n + 1
              RichText.SelStart = 0
              RichText.SelLength = Len(RichText.TextRTF)
              RichBox.SelStart = Len(RichBox.TextRTF)
              RichBox.SelRTF = RichText.SelRTF
              
              RichText.TextRTF = Adodc2.Recordset.Fields(0)
              RichText.SelStart = 0
              RichText.SelLength = Len(RichText.TextRTF)
              RichBox.SelStart = Len(RichBox.TextRTF)
              RichBox.SelRTF = RichText.SelRTF
              
              RichText.TextRTF = Chr(10) & Chr(13)
              RichText.SelStart = 0
              RichText.SelLength = Len(RichText.TextRTF)
              RichBox.SelStart = Len(RichBox.TextRTF)
              RichBox.SelRTF = RichText.SelRTF
            End If
            num = num + 1
          Loop
          num = 0
End Sub

Private Sub MainQuestion()
  RichText.SelStart = 0
          RichText.SelLength = Len(RichText.SelRTF)
          RichBox.SelStart = Len(RichBox.TextRTF)
          RichBox.SelRTF = RichText.SelRTF
          Do While num <= numExamId
            Adodc2.RecordSource = "SELECT Question FROM Exams WHERE ExamId=" _
             + Trim(Str(Arr_ExamId(num))) + " And TitleName =  '" _
             + Trim(Arr_TitleName(m)) + "'"
            Adodc2.Refresh
            If Adodc2.Recordset.EOF = False And Adodc2.Recordset.BOF = False Then
              RichText.TextRTF = Chr(13) & n & "、"
              n = n + 1
              RichText.SelStart = 0
              RichText.SelLength = Len(RichText.TextRTF)
              RichBox.SelStart = Len(RichBox.TextRTF)
              RichBox.SelRTF = RichText.SelRTF
              
              RichText.TextRTF = Adodc2.Recordset.Fields(0)
              RichText.SelStart = 0
              RichText.SelLength = Len(RichText.TextRTF)
              RichBox.SelStart = Len(RichBox.TextRTF)
              RichBox.SelRTF = RichText.SelRTF
              
              RichText.TextRTF = Chr(10) & Chr(13)
              RichText.SelStart = 0
              RichText.SelLength = Len(RichText.TextRTF)
              RichBox.SelStart = Len(RichBox.TextRTF)
              RichBox.SelRTF = RichText.SelRTF
            End If
            num = num + 1
          Loop
          num = 0
End Sub