frmadditems.frm

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

    
    lQuestion.Top = 500
    rtfTextQuestion.Move 100, 700, picItemContent.ScaleWidth - 200, (picItemContent.ScaleHeight - 500) / 2 - 300
    rtfTextQuestion.RightMargin = rtfTextQuestion.Width - 400
    lAnswer.Top = 500 + (picItemContent.ScaleHeight - 500) / 2
    rtfTextAnswer.Move 100, 700 + (picItemContent.ScaleHeight - 500) / 2, picItemContent.ScaleWidth - 200, (picItemContent.ScaleHeight - 500) / 2 - 300
    rtfTextAnswer.RightMargin = rtfTextAnswer.Width - 400
End Sub

Private Sub Form_Terminate()
    On Error Resume Next
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    If Not cnn Is Nothing Then
        cnn.Close
        Set cnn = Nothing
    End If
End Sub

Private Sub resetSpace()
    Dim oText As TextBox
    For Each oText In Me.txtSerial
        oText.Text = ""
    Next
    txtSerial(0).Text = Format(categoryId, "00")
    rtfTextQuestion.Text = ""
    rtfTextAnswer.Text = ""
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
    
    If categoryId = 1 Then
        txtSerial.Item(0).Text = idToNum(categoryId)
        txtSerial.Item(1).Text = idToNum(fieldId)
        txtSerial.Item(2).Text = idToNum(courseId)
        txtSerial.Item(3).Text = idToNum(pointId)
        txtSerial.Item(4).Text = rsItem!KEY_ID
        txtSerial.Item(5).Text = rsItem!TYPE_ID
        txtSerial.Item(6).Text = rsItem!LEVEL_ID
        txtSerial.Item(7).Text = rsItem!TARGET_ID
        txtSerial.Item(8).Text = rsItem!MAXMARK
        txtSerial.Item(9).Text = rsItem!DURATION
        txtS.Text = rsItem!SERIAL
    ElseIf categoryId = 2 Then
        txtSerial.Item(0).Text = idToNum(categoryId)
        txtSerial.Item(1).Text = idToNum(fieldId)
        txtSerial.Item(2).Text = idToNum(courseId)
        txtSerial.Item(3).Text = idToNum(pointId)
        txtSerial.Item(4).Text = rsItem!TYPE_ID
        txtSerial.Item(5).Text = rsItem!LEVEL_ID
        txtSerial.Item(6).Text = rsItem!TARGET_ID
        txtSerial.Item(7).Text = rsItem!MAXMARK
        txtSerial.Item(8).Text = rsItem!DURATION
        txtS.Text = rsItem!SERIAL
    ElseIf categoryId = 3 Then
        txtSerial.Item(0).Text = idToNum(categoryId)
        txtSerial.Item(1).Text = idToNum(fieldId)
        txtSerial.Item(2).Text = rsItem!LEVEL_ID
        txtSerial.Item(3).Text = rsItem!MAXMARK
        txtSerial.Item(4).Text = rsItem!DURATION
        txtS.Text = rsItem!SERIAL
    End If
    rtfTextQuestion.Text = rsItem!QUES_CONTENT
    rtfTextAnswer.Text = rsItem!ANSWER
End Sub

Private Sub myToolbar_ButtonClick(ByVal ButtonIndex As Integer, ByVal ButtonKey As String)
    'On Error Resume Next
    Select Case ButtonKey
        Case "new"
            addNewItem
            'frmMain.sbStatusBar.Panels(1).Text = frmAddItemC.Caption + ": 新增试题"
        Case "edit"
            editItem
            'frmMain.sbStatusBar.Panels(1).Text = frmAddItemC.Caption + ": 编辑试题"
        Case "save"
            updateItem
        Case "cancel"
            cancelItem
        Case "verify"
        Case "delete"
            deleteItem
        Case "previous"
            previousItem
        Case "next"
            nextItem
        Case "close"
            Unload Me
    End Select
End Sub

Private Sub addNewItem()
 ' On Error GoTo AddErr
  With rsItem
    If Not (.BOF And .EOF) Then
      mvBookMark = .Bookmark
    End If
    .AddNew
   ' frmMain.sbStatusBar.SimpleText = "新增试题"
    mbAddNewFlag = True
  End With
  SetButtons False
  
  resetSpace
'  txtSerial(1).SetFocus

  Exit Sub
AddErr:
  MsgBox Err.Description
    
End Sub

Private Sub editItem()
    On Error GoTo EditErr
    
    mvBookMark = rsItem.Bookmark
    SetButtons False
    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
    txtS.Visible = True
    
    oldItemSerial = txtS.Text
    
    Exit Sub

EditErr:
  MsgBox Err.Description
End Sub

Private Sub cancelItem()
  On Error Resume Next
  mbAddNewFlag = False
  rsItem.CancelUpdate
  If mvBookMark > 0 Then
    rsItem.Bookmark = mvBookMark
  Else
    rsItem.MoveFirst
  End If
  showItem
  SetButtons True
  
  If rsItem.EOF Then
    Unload Me
  End If
End Sub

Private Sub deleteItem()
  Response = MsgBox("确定要删除此题吗?", vbYesNo, Me.Caption)
  If Response = vbNo Then
     Cancel = True
  Else
    On Error GoTo DeleteErr
    With rsItem
      .Delete
      .MoveNext
      If .EOF Then .MoveLast
    End With
    showItem
    Exit Sub
DeleteErr:
    'MsgBox Err.Description
    resetSpace
  End If
End Sub

Private Sub checkIfSerialExistAlready()
    serialExistAlready = False
    
    ' check
    Set rsSerial = New Recordset
    rs.CursorLocation = adUseClient
    If categoryId = 1 Then
        sSQL = "select * from ITEM where CATEGORY_ID = " & pointId _
            & " and TYPE_ID = '" & Format(txtSerial(5).Text, "00") & "'" _
            & " and SERIAL not in ('" & oldItemSerial & "')" _
            & " Order by SERIAL"
    ElseIf categoryId = 2 Then
        sSQL = "select * from ITEM where CATEGORY_ID = " & pointId _
            & " and TYPE_ID = '" & Format(txtSerial(4).Text, "00") & "'" _
            & " and SERIAL not in ('" & oldItemSerial & "')" _
            & " Order by SERIAL"
    ElseIf categoryId = 3 Then
        sSQL = "select * from ITEM where CATEGORY_ID = " & fieldId _
            & " and SERIAL not in ('" & oldItemSerial & "')" _
            & " Order by SERIAL"
    End If
    rsSerial.Open sSQL, cnn, adOpenStatic, adLockReadOnly
    If Not rsSerial.EOF Then
        While Not rsSerial.EOF
            If rsSerial!SERIAL = txtS.Text Then
                serialExistAlready = True
                ' return suggested serial number
                rsSerial.MoveLast
                suggestedItemSerial = Format(rsSerial!SERIAL + 1, "0000")
            End If
            rsSerial.MoveNext
        Wend
    End If

    rsSerial.Close
End Sub

Private Sub getItemSerial()
    Set rsSerial = New Recordset
    rs.CursorLocation = adUseClient
    If categoryId = 1 Then
        sSQL = "select * from ITEM where CATEGORY_ID = " & pointId _
            & " and TYPE_ID = '" & Format(txtSerial(5).Text, "00") & "'" _
            & " Order by SERIAL"
    ElseIf categoryId = 2 Then
        sSQL = "select * from ITEM where CATEGORY_ID = " & pointId _
            & " and TYPE_ID = '" & Format(txtSerial(4).Text, "00") & "'" _
            & " Order by SERIAL"
    ElseIf categoryId = 3 Then
        sSQL = "select * from ITEM where CATEGORY_ID = " & fieldId _
            & " Order by SERIAL"
    End If
    rsSerial.Open sSQL, cnn, adOpenStatic, adLockReadOnly
    If rsSerial.EOF Then
        itemSerial = "0001"
    Else
        rsSerial.MoveLast
        itemSerial = Format(rsSerial!SERIAL + 1, "0000")
    End If
    rsSerial.Close
End Sub


Private Sub updateItem()
'  On Error GoTo UpdateErr
    
    checkSerial
    If checkIfCorrectSerial Then
        If rsItem!SERIAL <> "" Then
            If Len(txtS.Text) = 4 Then
                checkIfSerialExistAlready
                If serialExistAlready Then
                    MsgBox "序列号已存在，请重新输入序列号！建议序列号为：" & suggestedItemSerial, vbInformation + vbOKOnly
                    Exit Sub
                Else
                    itemSerial = txtS.Text
                End If
            Else
                MsgBox "请输入4位试题序列号！", vbInformation + vbOKOnly
                Exit Sub
            End If
        Else
            getItemSerial
        End If
    
        With rsItem
            If categoryId = 1 Then
                !CATEGORY_ID = pointId
                !KEY_ID = Format(txtSerial(4), "00")
                !TYPE_ID = Format(txtSerial(5), "00")
                !LEVEL_ID = Format(txtSerial(6), "00")
                !TARGET_ID = Format(txtSerial(7), "00")
                !MAXMARK = Format(txtSerial(8), "00")
                !DURATION = Format(txtSerial(9), "00")
            ElseIf categoryId = 2 Then
                !CATEGORY_ID = pointId
                !TYPE_ID = Format(txtSerial(4), "00")
                !LEVEL_ID = Format(txtSerial(5), "00")
                !TARGET_ID = Format(txtSerial(6), "00")
                !MAXMARK = Format(txtSerial(7), "00")
                !DURATION = Format(txtSerial(8), "00")
            ElseIf categoryId = 3 Then
                !CATEGORY_ID = fieldId
                !LEVEL_ID = Format(txtSerial(2), "00")
                !MAXMARK = Format(txtSerial(3), "00")
                !DURATION = Format(txtSerial(4), "00")
            End If
            !SERIAL = itemSerial
            !QUES_CONTENT = rtfTextQuestion.Text
            !ANSWER = rtfTextAnswer.Text
            !VERIFY_STATUS = "待审"
            !USAGE_STATUS = "未用"
            !INPUT_DATE = Date
            !INPUT_STAFF_ID = userName  'ID与系统管理模块相结合
            !VALIDITY = True
            .Update
        End With
    
        If mbAddNewFlag Then
          rsItem.MoveLast              'move to new record
        End If
      
        mbAddNewFlag = False
        SetButtons True
        showItem
    End If
    Exit Sub
  
UpdateErr:
  MsgBox Err.Description
End Sub

Private Sub nextItem()
 ' On Error GoTo GoNextError

  If Not rsItem.EOF Then rsItem.MoveNext
  If rsItem.EOF And rsItem.RecordCount > 0 Then
    Beep
     'reach the last record
    rsItem.MoveLast
  End If
  'show current record
 ' mbDataChanged = False
  showItem