frmtitleman.frm

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

VERSION 5.00
Begin VB.Form FrmTitleMan 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "题 型 管 理"
   ClientHeight    =   2805
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6420
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2805
   ScaleWidth      =   6420
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Height          =   2775
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   6375
      Begin VB.Frame Frame3 
         Caption         =   " 输入新的题型名 "
         Height          =   975
         Left            =   3240
         TabIndex        =   10
         Top             =   720
         Width           =   3015
         Begin VB.TextBox NewT_Name 
            Height          =   375
            Left            =   120
            TabIndex        =   11
            Top             =   360
            Width           =   2775
         End
      End
      Begin VB.Frame Frame2 
         Height          =   735
         Left            =   120
         TabIndex        =   5
         Top             =   1920
         Width           =   6135
         Begin VB.CommandButton Cmd_Cancel 
            Caption         =   "返回"
            Height          =   375
            Left            =   4560
            TabIndex        =   9
            Top             =   240
            Width           =   1335
         End
         Begin VB.CommandButton Cmd_Del 
            Caption         =   "删除题型"
            Height          =   375
            Left            =   3120
            TabIndex        =   8
            Top             =   240
            Width           =   1335
         End
         Begin VB.CommandButton Cmd_Modi 
            Caption         =   "修改题型"
            Height          =   375
            Left            =   1680
            TabIndex        =   7
            Top             =   240
            Width           =   1335
         End
         Begin VB.CommandButton Cmd_Add 
            Caption         =   "添加题型"
            Height          =   375
            Left            =   240
            TabIndex        =   6
            Top             =   240
            Width           =   1335
         End
      End
      Begin VB.ListBox lst_Name 
         Height          =   1320
         ItemData        =   "FrmTitleMan.frx":0000
         Left            =   960
         List            =   "FrmTitleMan.frx":0002
         TabIndex        =   4
         Top             =   600
         Width           =   2175
      End
      Begin VB.Label Label2 
         Caption         =   "题型名："
         Height          =   255
         Left            =   120
         TabIndex        =   3
         Top             =   600
         Width           =   855
      End
      Begin VB.Label lblClassName 
         Caption         =   "ClassName"
         Height          =   255
         Left            =   960
         TabIndex        =   2
         Top             =   240
         Width           =   4935
      End
      Begin VB.Label Label1 
         Caption         =   "课程名："
         Height          =   255
         Left            =   120
         TabIndex        =   1
         Top             =   240
         Width           =   855
      End
   End
End
Attribute VB_Name = "FrmTitleMan"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public num As Integer

Private Sub Cmd_Add_Click()
  If NewT_Name = "" Then
     i = MsgBox("请输入新的题型名！", vbOKOnly + 48, "警告")
     NewT_Name.SetFocus
     Exit Sub
  End If
  '查看是否有相同的题型名
  If MyTitle.In_DB(CurClass.ClassId, MakeStr(NewT_Name)) = True Then
    
    i = MsgBox("题型名存在，请重新输入题型名！", vbOKOnly + 48, "警告")
    NewT_Name.Text = ""
    NewT_Name.SetFocus
    Exit Sub
  End If
  
  With MyTitle
    .ClassId = CurClass.ClassId
    .TitleName = MakeStr(NewT_Name)
    .Insert
    i = MsgBox("添加新的题型成功！", vbOKOnly + 32, "信息")
    lst_Name_DblClick
  End With
  NewT_Name.Text = ""
End Sub

Private Sub Cmd_Cancel_Click()
  Unload Me
End Sub

Private Sub Cmd_Del_Click()
  '判断是否选择了要删除的题型
  If lst_Name.Text = "" Then
     i = MsgBox("请选择要删除的题型名！", vbOKOnly + 48, "警告")
     Exit Sub
  End If
  '判断题库是否有此题型号的题目，若有，则不能删除
  MyClass.Load_Class_ByUpper (CurClass.ClassId)
  num = 0
  Do While num <= FrmclassMan.num '得到子课程号
    If MyExam.In_DB(Arr_ClassId(num), Trim(lst_Name.Text)) = True Then
       MsgBox "题库中已有此题型的题目,不能删除！", vbOKOnly + 48, "警告"
       Exit Sub
       Exit Do
    End If
    num = num + 1
  Loop
  '确定删除题型
  If MsgBox("确定删除题型  " & lst_Name.Text & _
      "  吗？", vbOKCancel + 32, "请确定") = vbOK Then
     With MyTitle
       .Delete (lst_Name.Text)
       lst_Name_DblClick
     End With
  End If
End Sub

Private Sub Cmd_Modi_Click()
  '判断是否选择了要修改的题型
  If lst_Name.Text = "" Then
     i = MsgBox("请选择要修改的题型名！", vbOKOnly + 48, "警告")
     Exit Sub
  End If
  '判断是否输入了新的题型名
  If NewT_Name = "" Then
     MsgBox "请输入新的题型名！", vbOKOnly + 48, "警告"
     NewT_Name.SetFocus
     Exit Sub
  End If
  '判断输入的新题型名是否存在
  If lst_Name.Text <> Trim(NewT_Name.Text) Then
    If MyTitle.In_DB(CurClass.ClassId, MakeStr(NewT_Name)) = True Then
       MsgBox "题型  " & Trim(NewT_Name.Text) + "  已经存在！", _
         vbOKOnly + 48, "警告"
       Exit Sub
    End If
  End If
  '判断题库是否有此题型号的题目，若有，则不能修改
  MyClass.Load_Class_ByUpper (CurClass.ClassId)
  num = 0
  Do While num <= FrmclassMan.num
    
    If MyExam.In_DB(Arr_ClassId(num), Trim(lst_Name.Text)) = True Then
       MsgBox "题库中已有此题型的题目,不能修改！", vbOKOnly + 48, "警告"
       Exit Sub
    End If
    num = num + 1
  Loop
  '确定修改题型
  If MsgBox("确定修改题型  " & lst_Name.Text & _
      "  吗？", vbOKCancel + 32, "请确定") = vbOK Then
     With MyTitle
       .Update (MakeStr(NewT_Name.Text))
       lst_Name_DblClick
     End With
  End If
  NewT_Name.Text = ""
End Sub

Private Sub Form_Load()
  lblClassName.Caption = CurClass.Classname
  lst_Name_DblClick
End Sub

Private Sub lst_Name_Click()
  CurTitle.GetInfo (lst_Name.Text)
End Sub

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