frmmangselect.frm

自测考试系统

      Width           =   975
   End
   Begin VB.Label Label1 
      BackColor       =   &H00C0C0FF&
      BackStyle       =   0  'Transparent
      Caption         =   "题干内容"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   255
      Left            =   600
      TabIndex        =   9
      Top             =   360
      Width           =   1215
   End
   Begin VB.Label Label4 
      BackStyle       =   0  'Transparent
      Caption         =   "选项A"
      Height          =   255
      Left            =   600
      TabIndex        =   8
      Top             =   2160
      Width           =   735
   End
   Begin VB.Label Label5 
      BackStyle       =   0  'Transparent
      Caption         =   "选项B"
      Height          =   255
      Left            =   600
      TabIndex        =   7
      Top             =   2520
      Width           =   735
   End
   Begin VB.Label Label6 
      BackStyle       =   0  'Transparent
      Caption         =   "选项C"
      Height          =   255
      Left            =   600
      TabIndex        =   6
      Top             =   2880
      Width           =   735
   End
   Begin VB.Label Label7 
      BackStyle       =   0  'Transparent
      Caption         =   "选项D"
      Height          =   255
      Left            =   600
      TabIndex        =   5
      Top             =   3240
      Width           =   735
   End
End
Attribute VB_Name = "manyselect"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim isadding As Boolean
Dim objmanyselect As Recordset
Dim objcn As Connection


Private Sub cmdadd_Click()
Dim i As Byte
txtnews = "添加新记录"
txtquestion = ""
txtA = ""
txtB = ""
txtC = ""
txtD = ""
For i = 1 To 4
checkmany(i) = 0
Next
txtpoint = "1"
isadding = True
txtquestion.SetFocus
End Sub

Private Sub cmddelete_Click()
'根据是否处于添加记录状态执行不同的操作
If isadding Then
'退出添加记录状态，显示当前记录
isadding = False
   If objmanyselect.RecordCount <= 0 Then
      txtnews = "记录：无"
   Else
   show_data
   End If
Else
   Dim i As Byte
   If objmanyselect.RecordCount > 0 Then
      If MsgBox("是否删除记录？", vbYesNo + vbQuestion, "阅卷教师信息管理") = vbYes Then
      '执行删除当前记录操作
      objmanyselect.Delete
     '显示下一条记录
     For i = 1 To 4
     checkmany(i) = 0
     Next
      cmdmove(2).Value = True
      Else
      '显示当前记录数据
      show_data
      '显示当前记录和记录总数
      End If
    End If
End If
End Sub

Private Sub cmdexit_Click()
Unload Me
End Sub

Private Sub cmdmove_Click(Index As Integer)
With objmanyselect
Select Case Index
       Case 0
            If .RecordCount > 0 And Not .BOF Then .MoveFirst
       Case 1
            If .RecordCount > 0 And Not .BOF Then
            .MovePrevious
            If .BOF Then .MoveFirst
            End If
       Case 2
           If .RecordCount > 0 And Not .EOF Then
           .MoveNext
            If .EOF Then .MoveLast
           End If
       Case 3
            If .RecordCount > 0 And Not .EOF Then .MoveLast
End Select
Dim i As Byte
For i = 1 To 4
checkmany(i) = 0
Next
show_data
End With
If isadding Then isadding = False
End Sub
Private Sub show_data()
Dim i As Byte
With objmanyselect
If .RecordCount < 1 Then
txtnews = "记录：无" '显示记录提示信息
txtquestion = ""
txtpoint = ""
txtA = ""
txtB = ""
txtC = ""
txtD = ""
For i = 1 To 4
checkmany(i) = 0
Next
Else
  '显示当前记录数据
  txtquestion = .Fields("题干")
  txtpoint = .Fields("分数")
  txtA = .Fields("选项a")
  txtB = .Fields("选项b")
  txtC = .Fields("选项c")
  txtD = .Fields("选项d")
  For i = 1 To 4
  If Not InStr(.Fields("答案"), i) = 0 Then
     checkmany(i).Value = 1
  End If
  Next
  '显示当前记录编号和记录总数
  txtnews = "记录" & .AbsolutePosition & "/" & .RecordCount
  End If
End With
End Sub

Private Sub cmdsave_Click()
Dim objcopy As New Recordset
'在当前表中无数据并且不是添加记录时，不执行保存操作
     If Not isadding And objmanyselect.RecordCount < 1 Then Exit Sub
     If Trim(txtquestion) = "" Then
        MsgBox "题干不能为空！", vbCritical, "多项选择题管理"
        txtquestion.SetFocus
        txtquestion = ""
        ElseIf Not txtpoint Like "[1-9]" Then
        MsgBox "参考分数不符合要求！", vbCritical, "多项选择题管理"
        txtpoint.SetFocus
        txtpoint.SelStart = 0: txtpoint.SelLength = Len(txtpoint)
        '如何设置四个题干不能为空呢？
    Else
        Set objcopy = objmanyselect.Clone
        With objcopy
         If .RecordCount > 0 Then
            '检验题干是否重复
            .MoveFirst
            .Find "题干='" & Trim(txtquestion) & "'"
             If (isadding And Not .EOF) Or (Not isadding And Not .EOF And .AbsolutePosition <> objmanyselect.AbsolutePosition) Then
             MsgBox "试题重复，请修改！", vbCritical, "多项选择题管理"
             txtquestion.SetFocus
             txtquestion.SelStart = 0
             txtquestion.SelLength = Len(txtquestion)
             Exit Sub
             End If
             If isadding Then objmanyselect.AddNew
        Else
            '保存记录
             If isadding Then objmanyselect.AddNew
        End If
        objmanyselect.Fields("题干") = Trim(txtquestion)
        objmanyselect.Fields("分数") = Trim(txtpoint)
        objmanyselect.Fields("选项a") = Trim(txtA)
        objmanyselect.Fields("选项b") = Trim(txtB)
        objmanyselect.Fields("选项c") = Trim(txtC)
        objmanyselect.Fields("选项d") = Trim(txtD)
        Dim i As Byte
        Dim answer As String
        For i = 1 To 4
        If checkmany(i).Value = 1 Then
        answer = answer & "," & CStr(i)
        End If
        Next
        If Len(answer) > 0 Then
        answer = Right(answer, Len(answer) - 1)
        End If
        objmanyselect.Fields("答案") = answer
        objmanyselect.Update
        MsgBox "数据保存成功", vbInformation, "多项选择题管理"
        isadding = False
        '显示当前记录编号和记录总数
        txtnews = "记录：" & objmanyselect.AbsolutePosition & "/" & objmanyselect.RecordCount
        End With
    End If
End Sub

Private Sub Form_Load()
'建立数据库连接
Set objcn = New Connection '定义并实例化连接对象
With objcn '建立连接
           .Provider = "SQLOLEDB"
           .ConnectionString = "user id=sa;data source=(local);" & _
           "initial catalog=自测考试"
           .Open
End With
'获取单项选择题记录
Set objmanyselect = New Recordset
With objmanyselect
Set .ActiveConnection = objcn
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockOptimistic
.Open "select * from 多项选择题"
End With
cmdmove(0).Value = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
objcn.Close
Set objcn = Nothing
Set objmanyselect = Nothing
End Sub

Private Sub txtpoint_Change()
If Not (Chr(KeyPress) Like "[1-9]") Or KeyAscii = vbKeyBack Then
   KeyAscii = 0
End If
End Sub