testdiy.frm

自测考试系统

lblfl(i).Visible = True
labl(i).Visible = True
Next
'根据试题类型将当前的试题编号添加到试题列表中
Select Case cmbtype.ListIndex
       Case 0
       If ij = lstjudge.ListCount Then   '检查是否已经选足题量
          MsgBox "已经选足判断题！", vbInformation, Me.Caption
       Else
          add_item lstjudge '添加判断题
       End If
       Case 1
       If iso = lstselone.ListCount Then
         MsgBox "已经选足单选断题！", vbInformation, Me.Caption
       Else
         add_item lstselone '添加单选题
       End If
       Case 2
       If ism = lstselmany.ListCount Then
          MsgBox "已经选足多选题！", vbInformation, Me.Caption
       Else
          add_item lstselmany '添加多选题
       End If
       Case 3
       If ifl = idf(1) + idf(2) * 2 + idf(3) * 3 + idf(4) * 4 Then '检查是否已经选足题量
          MsgBox "已经选足填空题！", vbInformation, Me.Caption
       Else
         add_item lstfill '添加填空题
       End If
       Case 4
       If ians = lstanswer.ListCount Then
          MsgBox "已经选足问答题！", vbInformation, Me.Caption
       Else
          add_item lstanswer '添加问答题
       End If
    End Select
End Sub
Private Sub add_item(objlist As ListBox)
Dim code$, i%, m%, j%
code = objtemp.Fields("编号")
If objlist.ListCount > 0 Then
'检查是否已存在相同题号
     For i = 0 To objlist.ListCount - 1
     If objlist.List(i) = code Then Exit For
     Next
     If i < objlist.ListCount Then MsgBox "已选择了该题", vbCritical, Me.Caption
End If
    Select Case cmbtype.ListIndex
           Case 0
           objlist.AddItem code
           Case 1
           objlist.AddItem code
           Case 2
           objlist.AddItem code
           Case 4
           objlist.AddItem code
           Case 3
           m = 0
           For j = 1 To 4
            If objtemp.Fields("空" & Trim(Str(j))) <> "" Then m = m + 1
            Next
            If idivfil(m) = 0 Then
            MsgBox "你没有设置填空数为" & Trim(Str(m)) & "填空题！", vbCritical, Me.Caption
            ElseIf idf(m) < idivfil(m) Then
            objlist.AddItem code
            idf(m) = idf(m) + 1
            lblfl(m - 1) = "应选" & Trim(Str(idivfil(m))) & "道，差" _
                                    & Trim(Str(idivfil(m) - idf(m))) & "道"
            Else
            MsgBox "填空数为" & Trim(Str(m)) & "已够", vbCritical, Me.Caption
            End If
            End Select
  End Sub
     
Private Sub cmdExit_Click()
Unload Me
selecttest.Show
End Sub

Private Sub cmdMove_Click(Index As Integer)
With objtemp
      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
      If .RecordCount < 1 Then
         txtnews = "记录：无"
         txttest = ""
      Else
         show_data
      End If
End With
End Sub
Private Sub show_data()
Dim strdata$
With objtemp
Select Case cmbtype.ListIndex
       Case 0, 3, 4
       txttest = "编号:" & .Fields("编号") & vbCrLf & .Fields("题干")
       Case 1, 2
       txttest = "编号:" & .Fields("编号") & vbCrLf & .Fields("题干")
       txttest = txttest & vbCrLf & "(A)" & .Fields("选项A")
       txttest = txttest & vbCrLf & "(B)" & .Fields("选项B")
       txttest = txttest & vbCrLf & "(C)" & .Fields("选项C")
       txttest = txttest & vbCrLf & "(D)" & .Fields("选项D")
End Select
'显示当前记录编号和记录总数
txtnews = "记录:" & .AbsolutePosition & "/" & .RecordCount
End With
End Sub


Private Sub cmdok_Click()
    Dim i%, s%, a, b, c, d
    If ij > lstjudge.ListCount Then
       MsgBox "未选够判断题，还差" & Trim(Str(ij - lstjudge.ListCount)) & "道题！", vbCritical, Me.Caption
    ElseIf iso > lstselone.ListCount Then
       MsgBox "为选够单选题，还差" & Trim(Str(iso - lstselone.ListCount)) & "道题！", vbCritical, Me.Caption
    ElseIf ism > lstselmany.ListCount Then
       MsgBox "未选够多选题，还差" & Trim(Str(ism - lstselmany.ListCount)) & "道题！", vbCritical, Me.Caption
    ElseIf ians > lstanswer.ListCount Then
       MsgBox "未选够问答题，还差" & Trim(Str(ians - lstanswer.ListCount)) & "道题！", vbCritical, Me.Caption
    ElseIf ifl > idf(1) + idf(2) * 2 + idf(3) * 3 + idf(4) * 4 Then
       MsgBox "未选够填空题，还差" & Trim(Str(ifl - (idf(1) + idf(2) * 2 + idf(3) * 3 + idf(4) * 4))) & "道题！", vbCritical, Me.Caption
    Else
      '保存选择的试题
      For i = 0 To lstjudge.ListCount - 1
          vj(i + 1) = Val(lstjudge.List(i))
      Next
      selecttest.judge = vj
      For i = 0 To lstselone.ListCount - 1
         vso(i + 1) = Val(lstselone.List(i))
      Next
      selecttest.selone = vso
      For i = 0 To lstselmany.ListCount - 1
          vsm(i + 1) = Val(lstselmany.List(i))
      Next
      selecttest.selmany = vsm
      For i = 0 To lstfill.ListCount - 1
          vfl(i + 1) = Val(lstfill.List(i))
      Next
      For i = lstfill.ListCount + 1 To UBound(vfl)
          vfl(i) = 0
      Next
      selecttest.fill = vfl
      For i = 0 To lstanswer.ListCount - 1
          vans(i + 1) = Val(lstanswer.List(i))
      Next
      selecttest.answer = vans
      Unload Me
      selecttest.Show
End If
End Sub

Private Sub Form_Load()
Dim i%, m%, code$, j%
Set objtemp = objjudge.Clone
cmdmove(0).Value = True
cmbtype.ListIndex = 0
'获得各题型的小题数
ij = Val(selecttest.txtsum(0))
iso = Val(selecttest.txtsum(1))
ism = Val(selecttest.txtsum(2))
ifl = Val(selecttest.txtsum(4))
ians = Val(selecttest.txtsum(3))
For i = 1 To 4
idivfil(i) = Val(selecttest.txtdiv(i - 1))
Next
vj = selecttest.judge
vso = selecttest.selone
vsm = selecttest.selmany
vfl = selecttest.fill
vans = selecttest.answer
For i = 1 To 4
        idf(i) = 0
Next
For i = 0 To UBound(vfl)
    If vfl(i) <> 0 Then
    code = Trim(Str(vfl(i)))
    With objfill
   '计算选中题的填空数
    .MoveFirst
    .Find "编号=" & code & ""
    m = 0
    For j = 1 To 4
    If .Fields("空" & Trim(Str(j))) <> "" Then m = m + 1
    Next
    idf(m) = idf(m) + 1
End With
End If
Next
For i = 0 To 3
        lblfl(i) = "应选" & Trim(Str(idivfil(i + 1))) & "道，差" _
                                & Trim(Str(idivfil(i + 1) - idf(i + 1))) & "道"
        Next
lbljudge = "判断题共(" & selecttest.txtsum(0) & "道" & ")"
lblselone = "单选题共(" & selecttest.txtsum(1) & "道" & ")"
lblselmany = "多选题共(" & selecttest.txtsum(2) & "道" & ")"
lblanswer = "问答题共(" & selecttest.txtsum(3) & "道" & ")"
lblfill = "填空题共(" & selecttest.txtsum(4) & "空" & ")"

End Sub





Private Sub Form_Unload(Cancel As Integer)
Set objtemp = Nothing
End Sub

Private Sub lstanswer_Click()
'显示试题内容
cmbtype.ListIndex = 4
Set objtemp = objanswer.Clone
objtemp.Find "编号='" & lstanswer.List(lstanswer.ListIndex) & "'"
show_data

End Sub



Private Sub lstanswer_DblClick()
lstanswer.RemoveItem lstanswer.ListIndex
End Sub

Private Sub lstfill_Click()
'显示试题内容
cmbtype.ListIndex = 3
Set objtemp = objfill.Clone
objtemp.Find "编号='" & lstfill.List(lstfill.ListIndex) & "'"
show_data
End Sub

Private Sub lstfill_DblClick()
Dim code$, m%, i%
code = lstfill.List(lstfill.ListIndex)
lstfill.RemoveItem lstfill.ListIndex
With objfill
      .MoveFirst
      .Find "编号=" & code & ""
      m = 0
      For i = 1 To 4
      If .Fields("空" & Trim(Str(i))) <> "" Then m = m + 1
      Next
      idf(m) = idf(m) - 1
      lblfl(m - 1) = "应选" & Trim(Str(idivfil(m))) & "道,差" & Trim(Str(idivfil(m) - idf(m)))
      End With
End Sub

Private Sub lstjudge_Click()
'显示试题内容
cmbtype.ListIndex = 0
Set objtemp = objjudge.Clone
objtemp.Find "编号='" & lstjudge.List(lstjudge.ListIndex) & "'"
show_data
End Sub

Private Sub lstjudge_DblClick()
lstjudge.RemoveItem lstjudge.ListIndex
End Sub




Private Sub lstselmany_Click()
'显示试题内容
cmbtype.ListIndex = 2
Set objtemp = objselmany.Clone
objtemp.Find "编号='" & lstselmany.List(lstselmany.ListIndex) & "'"
show_data
End Sub

Private Sub lstselmany_DblClick()
lstselmany.RemoveItem lstselmany.ListIndex
End Sub



Private Sub lstselone_Click()
'显示试题内容
cmbtype.ListIndex = 1
Set objtemp = objselone.Clone
objtemp.Find "编号='" & lstselone.List(lstselone.ListIndex) & "'"
show_data
End Sub

Private Sub lstselone_DblClick()
lstselone.RemoveItem lstselone.ListIndex
End Sub