frmadditems.frm

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

  rtfTextQuestion.SetFocus

  Exit Sub
GoNextError:
  MsgBox Err.Description
End Sub

Private Sub previousItem()
  On Error GoTo GoPrevError

  If Not rsItem.BOF Then rsItem.MovePrevious
  If rsItem.BOF And rsItem.RecordCount > 0 Then
    Beep
    'reach the last record
    rsItem.MoveFirst
  End If
  'show current record
  'mbDataChanged = False
  showItem
  rtfTextQuestion.SetFocus

  Exit Sub

GoPrevError:
  MsgBox Err.Description
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error Resume Next
    If focusOnQuestion Then
        Select Case Button.Key
            Case "剪切"
                Clipboard.SetText rtfTextQuestion.SelRTF
                rtfTextQuestion.SelText = vbNullString
            Case "复制"
                Clipboard.SetText rtfTextQuestion.SelRTF
            Case "粘贴"
                rtfTextQuestion.SelRTF = Clipboard.GetText
            Case "粗体"
                rtfTextQuestion.SelBold = Not rtfTextQuestion.SelBold
                Button.Value = IIf(rtfTextQuestion.SelBold, tbrPressed, tbrUnpressed)
            Case "斜体"
                rtfTextQuestion.SelItalic = Not rtfTextQuestion.SelItalic
                Button.Value = IIf(rtfTextQuestion.SelItalic, tbrPressed, tbrUnpressed)
            Case "下划线"
                rtfTextQuestion.SelUnderline = Not rtfTextQuestion.SelUnderline
                Button.Value = IIf(rtfTextQuestion.SelUnderline, tbrPressed, tbrUnpressed)
            Case "左对齐"
                rtfTextQuestion.SelAlignment = rtfLeft
            Case "置中"
                rtfTextQuestion.SelAlignment = rtfCenter
            Case "右对齐"
                rtfTextQuestion.SelAlignment = rtfRight
        End Select
    ElseIf focusOnAnswer Then
        Select Case Button.Key
            Case "剪切"
                Clipboard.SetText rtfTextAnswer.SelRTF
                rtfTextAnswer.SelText = vbNullString
            Case "复制"
                Clipboard.SetText rtfTextAnswer.SelRTF
            Case "粘贴"
                rtfTextAnswer.SelRTF = Clipboard.GetText
            Case "粗体"
                rtfTextAnswer.SelBold = Not rtfTextAnswer.SelBold
                Button.Value = IIf(rtfTextAnswer.SelBold, tbrPressed, tbrUnpressed)
            Case "斜体"
                rtfTextAnswer.SelItalic = Not rtfTextAnswer.SelItalic
                Button.Value = IIf(rtfTextAnswer.SelItalic, tbrPressed, tbrUnpressed)
            Case "下划线"
                rtfTextAnswer.SelUnderline = Not rtfTextAnswer.SelUnderline
                Button.Value = IIf(rtfTextAnswer.SelUnderline, tbrPressed, tbrUnpressed)
            Case "左对齐"
                rtfTextAnswer.SelAlignment = rtfLeft
            Case "置中"
                rtfTextAnswer.SelAlignment = rtfCenter
            Case "右对齐"
                rtfTextAnswer.SelAlignment = rtfRight
        End Select
    End If
    
End Sub


Private Sub txtSerial_Change(Index As Integer)
    On Error Resume Next
    Dim maxTxtLength As Integer
    Dim inputTxt As String
    
    If Index = 10 Then
        maxTxtLength = 4
    Else
        maxTxtLength = 2
    End If
    
    inputTxt = txtSerial.Item(Index).Text
    
    If Len(inputTxt) >= maxTxtLength Then
        If Index >= 10 Then
            rtfTextQuestion.SetFocus
        Else
            txtSerial.Item(Index + 1).SetFocus
        End If
    End If
End Sub

Private Sub txtSerial_GotFocus(Index As Integer)
    txtSerial.Item(Index).SelStart = 0
    txtSerial.Item(Index).SelLength = Len(txtSerial.Item(Index).Text)
End Sub

Private Sub txtSerial_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    On Error Resume Next
    If KeyCode = vbKeyLeft Then
        txtSerial.Item(Index - 1).SetFocus
    ElseIf KeyCode = vbKeyRight Then
        txtSerial.Item(Index + 1).SetFocus
    End If
End Sub


Private Sub checkSerial()
    checkIfCorrectSerial = True
    Dim errorMsgName As String
    Dim i As Integer
    
    If categoryId = 1 Then
        sSQL = "select * from CATEGORIES where NUM = '" & Format(txtSerial.Item(1).Text, "00") _
        & "' and SUPER_CATEGORY_ID = " & categoryId
        rs.Open sSQL, cnn
        If rs.EOF Then
            errorMsgName = "科目"
            i = 1
            GoTo errorMsg
        Else
            fieldId = rs!CATEGORY_ID
        End If
        rs.Close
            
        sSQL = "select * from CATEGORIES where NUM = '" & Format(txtSerial.Item(2).Text, "00") _
            & "' and SUPER_CATEGORY_ID = " & fieldId
        rs.Open sSQL, cnn
        If rs.EOF Then
            errorMsgName = "课程"
            i = 2
            GoTo errorMsg
        Else
            courseId = rs!CATEGORY_ID
        End If
        rs.Close
            
        sSQL = "select * from CATEGORIES where NUM = '" & Format(txtSerial.Item(3).Text, "00") _
            & "' and SUPER_CATEGORY_ID = " & courseId
        rs.Open sSQL, cnn
        If rs.EOF Then
            errorMsgName = "知识点"
            i = 3
            GoTo errorMsg
        Else
            pointId = rs!CATEGORY_ID
        End If
        rs.Close
        
        sSQL = "select * from ITEM_TYPE where TYPE_ID = '" & Format(txtSerial(5).Text, "00") & "'" _
            & " and CATEGORY_ID = " & categoryId
        rs.Open sSQL, cnn
        If rs.EOF Then
            errorMsgName = "题型"
            i = 5
            GoTo errorMsg
        End If
        rs.Close
            
        sSQL = "select * from ITEM_LEVEL where LEVEL_ID = '" & Format(txtSerial(6).Text, "00") & "'" _
            & " and CATEGORY_ID = " & categoryId
        rs.Open sSQL, cnn
        If rs.EOF Then
            errorMsgName = "难度"
            i = 6
            GoTo errorMsg
        End If
        rs.Close
            
        sSQL = "select * from ITEM_TARGET where TARGET_ID = '" & Format(txtSerial(7).Text, "00") & "'" _
            & " and CATEGORY_ID = " & categoryId
        rs.Open sSQL, cnn
        If rs.EOF Then
            errorMsgName = "目标层次"
            i = 7
            GoTo errorMsg
        End If
        rs.Close
    ElseIf categoryId = 2 Then
        sSQL = "select * from CATEGORIES where NUM = '" & Format(txtSerial.Item(1).Text, "00") _
        & "' and SUPER_CATEGORY_ID = " & categoryId
        rs.Open sSQL, cnn
        If rs.EOF Then
            errorMsgName = "专业"
            i = 1
            GoTo errorMsg
        Else
            fieldId = rs!CATEGORY_ID
        End If
        rs.Close
            
        sSQL = "select * from CATEGORIES where NUM = '" & Format(txtSerial.Item(2).Text, "00") _
            & "' and SUPER_CATEGORY_ID = " & fieldId
        rs.Open sSQL, cnn
        If rs.EOF Then
            errorMsgName = "课程"
            i = 2
            GoTo errorMsg
        Else
            courseId = rs!CATEGORY_ID
        End If
        rs.Close
            
        sSQL = "select * from CATEGORIES where NUM = '" & Format(txtSerial.Item(3).Text, "00") _
            & "' and SUPER_CATEGORY_ID = " & courseId
        rs.Open sSQL, cnn
        If rs.EOF Then
            errorMsgName = "知识点"
            i = 3
            GoTo errorMsg
        Else
            pointId = rs!CATEGORY_ID
        End If
        rs.Close
        
        sSQL = "select * from ITEM_TYPE where TYPE_ID = '" & Format(txtSerial(4).Text, "00") & "'" _
            & " and CATEGORY_ID = " & categoryId
        rs.Open sSQL, cnn
        If rs.EOF Then
            errorMsgName = "题型"
            i = 4
            GoTo errorMsg
        End If
        rs.Close
            
        sSQL = "select * from ITEM_LEVEL where LEVEL_ID = '" & Format(txtSerial(5).Text, "00") & "'" _
            & " and CATEGORY_ID = " & categoryId
        rs.Open sSQL, cnn
        If rs.EOF Then
            errorMsgName = "难度"
            i = 5
            GoTo errorMsg
        End If
        rs.Close
            
        sSQL = "select * from ITEM_TARGET where TARGET_ID = '" & Format(txtSerial(6).Text, "00") & "'" _
            & " and CATEGORY_ID = " & categoryId
        rs.Open sSQL, cnn
        If rs.EOF Then
            errorMsgName = "目标层次"
            i = 6
            GoTo errorMsg
        End If
        rs.Close
    ElseIf categoryId = 3 Then
        sSQL = "select * from CATEGORIES where NUM = '" & Format(txtSerial.Item(1).Text, "00") _
        & "' and SUPER_CATEGORY_ID = " & categoryId
        rs.Open sSQL, cnn
        If rs.EOF Then
            errorMsgName = "测评要素"
            i = 1
            GoTo errorMsg
        Else
            fieldId = rs!CATEGORY_ID
        End If
        rs.Close
        
        sSQL = "select * from ITEM_LEVEL where LEVEL_ID = '" & Format(txtSerial(2).Text, "00") & "'" _
            & " and CATEGORY_ID = " & categoryId
        rs.Open sSQL, cnn
        If rs.EOF Then
            errorMsgName = "难度"
            i = 2
            GoTo errorMsg
        End If
        rs.Close
    End If
    Exit Sub
    
errorMsg:
    checkIfCorrectSerial = False
    MsgBox errorMsgName & "编号输入有误，请核对规范的编码规则！"
    txtSerial(i).SetFocus
    rs.Close
End Sub


Private Sub SetButtons(bVal As Boolean)
    myToolbar.ButtonVisible(1) = bVal
    myToolbar.ButtonVisible(2) = bVal
    myToolbar.ButtonVisible(3) = bVal
    myToolbar.ButtonVisible(4) = bVal
    myToolbar.ButtonVisible(5) = bVal
    myToolbar.ButtonVisible(6) = bVal
    If bVal Then
        If categoryId = 1 Then
            Label1.Caption = "类 别  -  科 目 -  课 程 -  知识点 - 评价要素 - 题 型 - 难 度 - 目标层次 - 分 值 - 答题时间 - 试题编号"
            lBar(9).Visible = True
        ElseIf categoryId = 2 Then
            Label1.Caption = "类 别  -  专 业 -  课 程 -  知识点 -  题 型 - 难 度 - 目标层次 - 分 值 - 答题时间 - 试题编号"
            lBar(8).Visible = True
        ElseIf categoryId = 3 Then
            Label1.Caption = "类 别  - 评价要素 - 难 度 - 分 值 - 答题时间 - 试题编号"
            lBar(4).Visible = True
        End If
    Else
        If categoryId = 1 Then
            Label1.Caption = "类 别  -  科 目 -  课 程 -  知识点 - 评价要素 - 题 型 - 难 度 - 目标层次 - 分 值 - 答题时间"
            lBar(9).Visible = False
        ElseIf categoryId = 2 Then
            Label1.Caption = "类 别  -  专 业 -  课 程 -  知识点 -  题 型 - 难 度 - 目标层次 - 分 值 - 答题时间"
            lBar(8).Visible = False
        ElseIf categoryId = 3 Then
            Label1.Caption = "类 别  - 评价要素 - 难 度 - 分 值 - 答题时间"
            lBar(4).Visible = False
        End If
    End If
    txtS.Visible = bVal
    myToolbar.ButtonVisible(7) = Not bVal
    myToolbar.ButtonVisible(8) = Not bVal
    'myToolbar.ButtonVisible(9) = bVal
End Sub