frmverify.frm

这是我们公司的题库管理系统

            BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
               Key             =   "下划线"
               Object.ToolTipText     =   "1045"
               ImageKey        =   "Underline"
            EndProperty
            BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
               Style           =   3
            EndProperty
            BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
               Key             =   "左对齐"
               Object.ToolTipText     =   "1046"
               ImageKey        =   "Align Left"
               Style           =   2
            EndProperty
            BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
               Key             =   "置中"
               Object.ToolTipText     =   "1047"
               ImageKey        =   "Center"
               Style           =   2
            EndProperty
            BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} 
               Key             =   "右对齐"
               Object.ToolTipText     =   "1048"
               ImageKey        =   "Align Right"
               Style           =   2
            EndProperty
         EndProperty
      End
      Begin RichTextLib.RichTextBox rtfTextQuestion 
         Height          =   1995
         Left            =   120
         TabIndex        =   9
         Top             =   720
         Width           =   3000
         _ExtentX        =   5292
         _ExtentY        =   3519
         _Version        =   393217
         Enabled         =   -1  'True
         ScrollBars      =   3
         TextRTF         =   $"frmVerify.frx":BA66
      End
      Begin RichTextLib.RichTextBox rtfTextAnswer 
         Height          =   1995
         Left            =   120
         TabIndex        =   10
         Top             =   3120
         Width           =   3000
         _ExtentX        =   5292
         _ExtentY        =   3519
         _Version        =   393217
         Enabled         =   -1  'True
         ScrollBars      =   3
         TextRTF         =   $"frmVerify.frx":BB03
      End
      Begin VB.Label lAnswer 
         AutoSize        =   -1  'True
         Caption         =   "参考答案：（请在下面输入试题的解析和答案）"
         Height          =   180
         Left            =   120
         TabIndex        =   28
         Top             =   2880
         Width           =   3780
      End
      Begin VB.Label lQuestion 
         AutoSize        =   -1  'True
         Caption         =   "题目内容：（请在下面编辑试题内容）"
         Height          =   180
         Left            =   120
         TabIndex        =   27
         Top             =   480
         Width           =   3060
      End
   End
End
Attribute VB_Name = "frmItemVerify"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim rsItem As adodb.Recordset

'Dim categoryId As Integer
Dim fieldId As Integer
Dim courseId As Integer
Dim pointId As Integer

Dim mvBookMark As Variant
Dim mbAddNewFlag As Boolean

Dim focusOnQuestion As Boolean
Dim focusOnAnswer As Boolean

Dim rsSerial As adodb.Recordset  '添加试题序号所用
Dim serialExistAlready As Boolean
Dim itemSerial As String   '初始化试题序号
Dim oldItemSerial As String
Dim suggestedItemSerial As String

Private Sub rtfTextQuestion_GotFocus()
    focusOnQuestion = True
    focusOnAnswer = False
End Sub

Private Sub rtfTextAnswer_GotFocus()
    focusOnQuestion = False
    focusOnAnswer = True
End Sub

Private Sub rtfTextQuestion_SelChange()
    tbToolBar.Buttons("粗体").Value = IIf(rtfTextQuestion.SelBold, tbrPressed, tbrUnpressed)
    tbToolBar.Buttons("斜体").Value = IIf(rtfTextQuestion.SelItalic, tbrPressed, tbrUnpressed)
    tbToolBar.Buttons("下划线").Value = IIf(rtfTextQuestion.SelUnderline, tbrPressed, tbrUnpressed)
    tbToolBar.Buttons("左对齐").Value = IIf(rtfTextQuestion.SelAlignment = rtfLeft, tbrPressed, tbrUnpressed)
    tbToolBar.Buttons("置中").Value = IIf(rtfTextQuestion.SelAlignment = rtfCenter, tbrPressed, tbrUnpressed)
    tbToolBar.Buttons("右对齐").Value = IIf(rtfTextQuestion.SelAlignment = rtfRight, tbrPressed, tbrUnpressed)
End Sub

Private Sub rtfTextAnswer_SelChange()
    tbToolBar.Buttons("粗体").Value = IIf(rtfTextAnswer.SelBold, tbrPressed, tbrUnpressed)
    tbToolBar.Buttons("斜体").Value = IIf(rtfTextAnswer.SelItalic, tbrPressed, tbrUnpressed)
    tbToolBar.Buttons("下划线").Value = IIf(rtfTextAnswer.SelUnderline, tbrPressed, tbrUnpressed)
    tbToolBar.Buttons("左对齐").Value = IIf(rtfTextAnswer.SelAlignment = rtfLeft, tbrPressed, tbrUnpressed)
    tbToolBar.Buttons("置中").Value = IIf(rtfTextAnswer.SelAlignment = rtfCenter, tbrPressed, tbrUnpressed)
    tbToolBar.Buttons("右对齐").Value = IIf(rtfTextAnswer.SelAlignment = rtfRight, tbrPressed, tbrUnpressed)
End Sub


Private Sub loadItemsForOthers()
    
    Dim combTableName(3) As String
    Dim combFieldName(3) As String
    
    combTableName(0) = "ITEM_TYPE"
    combTableName(1) = "ITEM_LEVEL"
    combTableName(2) = "ITEM_TARGET"
    combFieldName(0) = "TYPE_ID"
    combFieldName(1) = "LEVEL_ID"
    combFieldName(2) = "TARGET_ID"
    
    For i = 0 To 2
        sSQL = "select * from " & combTableName(i) & " where CATEGORY_ID = " & categoryId & " Order by " & combFieldName(i)
        rs.Open sSQL, cnn
        ' combList(0) 为 题型
        ' combList(1) 为 难度
        ' combList(2) 为 目标层次
        While rs.EOF = False
            CombList(i).AddItem (rs!Name)
            CombList(i).ItemData(CombList(i).NewIndex) = rs.Fields(combFieldName(i))
            rs.MoveNext
        Wend
        rs.Close
    Next i
End Sub

Private Sub loadItemsForField()
    sSQL = "select * from CATEGORIES where SUPER_CATEGORY_ID = " & categoryId & " order by CATEGORY_ID"
    rs.Open sSQL, cnn
    While rs.EOF = False
        combField.AddItem (rs!Name)
        combField.ItemData(combField.NewIndex) = rs!CATEGORY_ID
        rs.MoveNext
    Wend
    rs.Close
End Sub

Private Sub CombField_Click()
    If fieldId <> combField.ItemData(combField.ListIndex) Then
        fieldId = combField.ItemData(combField.ListIndex)
        combCourse.Clear
        combPoint.Clear
        courseId = 0
        pointId = 0
        loadItemsForCourse
    End If
End Sub

Private Sub loadItemsForCourse()
    sSQL = "select * from CATEGORIES where SUPER_CATEGORY_ID = " & fieldId & " order by CATEGORY_ID"
    rs.Open sSQL, cnn
    While rs.EOF = False
        combCourse.AddItem (rs!Name)
        combCourse.ItemData(combCourse.NewIndex) = rs!CATEGORY_ID
        rs.MoveNext
    Wend
    rs.Close
End Sub

Private Sub combCourse_Click()
    If courseId <> combCourse.ItemData(combCourse.ListIndex) Then
        courseId = combCourse.ItemData(combCourse.ListIndex)
        combPoint.Clear
        pointId = 0
        loadItemsForPoint
    End If
End Sub

Private Sub loadItemsForPoint()
    sSQL = "select * from CATEGORIES where SUPER_CATEGORY_ID = " & courseId & " order by CATEGORY_ID"
    rs.Open sSQL, cnn
    While rs.EOF = False
        combPoint.AddItem (rs!Name)
        combPoint.ItemData(combPoint.NewIndex) = rs!CATEGORY_ID
        rs.MoveNext
    Wend
    rs.Close
End Sub

Private Sub combPoint_Click()
    If pointId <> combPoint.ItemData(combPoint.ListIndex) Then
        pointId = combPoint.ItemData(combPoint.ListIndex)
    End If
End Sub

Private Sub resetSpace()
    combField.Clear
    combCourse.Clear
    combPoint.Clear
    CombList(0).Clear
    CombList(1).Clear
    CombList(2).Clear
    fieldId = -1
    courseId = -1
    pointId = -1
    
    Dim oCombo As ComboBox
    For Each oCombo In Me.CombList
        oCombo.Clear
    Next
    txtMark.Text = ""
    txtDuration.Text = ""
    rtfTextQuestion.Text = ""
    rtfTextAnswer.Text = ""
    txtSerial.Text = ""
    
    If categoryId = 1 Then
        lField.Caption = "科    目"
        lCourse.Visible = True
        combCourse.Visible = True
        lPoint.Visible = True
        combPoint.Visible = True
        lType.Visible = True
        CombList(0).Visible = True
        lTarget.Visible = True
        CombList(2).Visible = True
    ElseIf categoryId = 2 Then
        lField.Caption = "专    业"
        lCourse.Visible = True
        combCourse.Visible = True
        lPoint.Visible = True
        combPoint.Visible = True
        lType.Visible = True
        CombList(0).Visible = True
        lTarget.Visible = True
        CombList(2).Visible = True
    ElseIf categoryId = 3 Then
        lField.Caption = "测 评 要 素"
        lCourse.Visible = False
        combCourse.Visible = False
        lPoint.Visible = False
        combPoint.Visible = False
        lType.Visible = False
        CombList(0).Visible = False
        lTarget.Visible = False
        CombList(2).Visible = False
    End If
    
    loadItemsForField
    loadItemsForOthers
End Sub

Private Sub showItem()
    Dim i(4) As Integer
    i(0) = rsItem!CATEGORY_ID
    i(1) = getSuperId(i(0))
    i(2) = getSuperId(i(1))
    
    If i(2) = -1 Then
        fieldId = i(0)
    Else
        fieldId = i(2)
        courseId = i(1)
        pointId = i(0)
    End If
    
    combField.Clear
    combCourse.Clear
    combPoint.Clear
    CombList(0).Clear
    CombList(1).Clear
    CombList(2).Clear
    
    loadItemsForField
    loadItemsForCourse
    loadItemsForPoint
    loadItemsForOthers
    
    combField.ListIndex = CInt(idToNum(fieldId)) - 1
    If categoryId = 1 Or categoryId = 2 Then
        combCourse.ListIndex = CInt(idToNum(courseId)) - 1
        combPoint.ListIndex = CInt(idToNum(pointId)) - 1
        CombList(0).ListIndex = CInt(rsItem!TYPE_ID) - 1    ' 如果ID不连续，可能会有潜在的问题
        CombList(2).ListIndex = CInt(rsItem!TARGET_ID) - 1    ' 如果ID不连续，可能会有潜在的问题
    End If
    CombList(1).ListIndex = CInt(rsItem!LEVEL_ID) - 1    ' 如果ID不连续，可能会有潜在的问题
   
    txtMark.Text = rsItem!MAXMARK
    txtDuration.Text = rsItem!DURATION
    If rsItem!VALIDITY Then
        checkValidity.Value = 1
    Else
        checkValidity.Value = 0
    End If
    rtfTextQuestion.Text = rsItem!QUES_CONTENT
    rtfTextAnswer.Text = rsItem!ANSWER
    txtSerial.Text = rsItem!SERIAL
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ifFromSearch = False
End Sub

Private Sub Form_Load()
    
    Screen.MousePointer = vbHourglass
    
    If categoryId = 1 Then
        Me.Caption = "试题审核——公共题库"
    ElseIf categoryId = 2 Then
        Me.Caption = "试题审核——专业题库"
    ElseIf categoryId = 3 Then
        Me.Caption = "试题审核——面试题库"
    End If
    
    ' 打开连接
    Set cnn = New Connection
    cnn.Open sConnect
    Set rs = New Recordset
    rs.CursorLocation = adUseClient
    rs.CursorType = adOpenKeyset
    rs.LockType = adLockOptimistic
    Set rsItem = New Recordset
    rsItem.CursorLocation = adUseClient
    rsItem.CursorType = adOpenKeyset
    rsItem.LockType = adLockOptimistic
    If ifFromSearch Then
        Select Case searchMethod
            Case 1
                sSQL = "select * from ITEM " _
                        & "where ITEM.CATEGORY_ID = " & verifyCategory _
                        & " and VERIFY_STATUS = '" & verifyStatus & "'" _
                        & " order by ITEM_ID"
            Case 2
                sSQL = "select * from ITEM " _
                        & "where ITEM.CATEGORY_ID = " & verifyCategory _
                        & " and VERIFY_STATUS = '" & verifyStatus & "'" _
                        & " and ITEM.TARGET_ID = '" & verifyTargetId & "'" _
                        & " order by ITEM_ID"
            Case 3
                sSQL = "select * from ITEM " _
                        & "where ITEM.CATEGORY_ID = " & verifyCategory _
                        & " and VERIFY_STATUS = '" & verifyStatus & "'" _
                        & " and ITEM.LEVEL_ID = '" & verifyLevelId & "'" _
                        & " order by ITEM_ID"
            Case 4
                sSQL = "select * from ITEM " _
                        & "where ITEM.CATEGORY_ID = " & verifyCategory _
                        & " and VERIFY_STATUS = '" & verifyStatus & "'" _
                        & " and ITEM.TYPE_ID = '" & verifyTypeId & "'" _
                        & " order by ITEM_ID"
            Case 5
                sSQL = "select * from ITEM " _
                        & "where ITEM.CATEGORY_ID = " & verifyCategory _
                        & " and VERIFY_STATUS = '" & verifyStatus & "'" _
                        & " and ITEM.TYPE_ID = '" & verifyTypeId & "'" _
                        & " and ITEM.LEVEL_ID = '" & verifyLevelId & "'" _
                        & " order by ITEM_ID"
            Case 6
                sSQL = "select * from ITEM " _
                        & "where ITEM.CATEGORY_ID = " & verifyCategory _
                        & " and VERIFY_STATUS = '" & verifyStatus & "'" _
                        & " and ITEM.LEVEL_ID = '" & verifyLevelId & "'" _
                        & " and ITEM.TARGET_ID = '" & verifyTargetId & "'" _
                        & " order by ITEM_ID"
            Case 7
                sSQL = "select * from ITEM " _
                        & "where ITEM.CATEGORY_ID = " & verifyCategory _
                        & " and VERIFY_STATUS = '" & verifyStatus & "'" _
                        & " and ITEM.TYPE_ID = '" & verifyTypeId & "'" _
                        & " and ITEM.TARGET_ID = '" & verifyTargetId & "'" _
                        & " order by ITEM_ID"
            Case 8
                sSQL = "select * from ITEM " _
                        & "where ITEM.CATEGORY_ID = " & verifyCategory _
                        & " and VERIFY_STATUS = '" & verifyStatus & "'" _
                        & " and ITEM.TYPE_ID = '" & verifyTypeId & "'" _
                        & " and ITEM.LEVEL_ID = '" & verifyLevelId & "'" _
                        & " and ITEM.TARGET_ID = '" & verifyTargetId & "'" _
                        & " order by ITEM_ID"
            Case 9
                sSQL = "select * from ITEM " _
                        & "where ITEM.CATEGORY_ID = " & verifyCategory _
                        & " and VERIFY_STATUS = '" & verifyStatus & "'" _
                        & " order by ITEM_ID"
            Case 10
                sSQL = "select * from ITEM " _
                        & "where ITEM.CATEGORY_ID = " & verifyCategory _
                        & " and VERIFY_STATUS = '" & verifyStatus & "'" _
                        & " and ITEM.LEVEL_ID = '" & verifyLevelId & "'" _
                        & " order by ITEM_ID"
        End Select
    Else
        If categoryId = 1 Or categoryId = 2 Then