zjz.frm

本文首先分析了自动组卷系统在具体的教学活动过程中的实际需求

            Weight          =   700
            Underline       =   0   'False
            Italic          =   -1  'True
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Index           =   3
         Left            =   3240
         TabIndex        =   16
         Top             =   3360
         Width           =   495
      End
      Begin VB.Label Label8 
         Caption         =   "%"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   20.25
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   -1  'True
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Index           =   4
         Left            =   3360
         TabIndex        =   15
         Top             =   4080
         Width           =   495
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "试卷生成"
      Height          =   4575
      Index           =   2
      Left            =   -2280
      TabIndex        =   1
      Top             =   6240
      Width           =   6135
      Begin VB.CommandButton qingkong 
         Caption         =   "清空临时文件"
         Enabled         =   0   'False
         Height          =   495
         Left            =   5160
         TabIndex        =   34
         Top             =   4200
         Width           =   975
      End
      Begin VB.CommandButton editcmd 
         Caption         =   "编辑试卷"
         Enabled         =   0   'False
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   15.75
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   615
         Left            =   2160
         TabIndex        =   6
         Top             =   3120
         Width           =   2055
      End
      Begin VB.CommandButton Command2 
         Caption         =   "单击这里随机抽题"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   20.25
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   735
         Left            =   1080
         TabIndex        =   3
         Top             =   960
         Width           =   3615
      End
      Begin VB.Label Label10 
         Caption         =   "这可能需要一些时间，请耐心等待……"
         Height          =   735
         Left            =   600
         TabIndex        =   33
         Top             =   2400
         Width           =   3735
      End
   End
   Begin VB.Image Image1 
      Height          =   1650
      Left            =   0
      Top             =   -840
      Width           =   1770
   End
End
Attribute VB_Name = "zj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim aval(0 To 4) As Integer '每种题型的一题的分值
Dim tmf(0 To 4) As Integer '题型分布
Dim m, n As Integer
Dim btl(0 To 4) As Boolean
Dim andxs(0 To 4) As Long
Dim ndxs(0 To 4) As Long
Dim tl(0 To 4) As Integer '题量
Dim cnt(0 To 4) As Integer '每种题型的题目总数
Dim rtmp(0 To 50) As Integer
Dim zs As String
Dim tim As String
Dim tem(1 To 25) As Integer
 Dim total(0 To 4) As Integer '实际抽取的每种类型题目的总分值
Dim bh(0 To 4)
Dim totalf As Integer
Private Sub back_Click()
For n = 0 To 2
If m - 1 = n Then
Frame1(n).Visible = True
Else
Frame1(n).Visible = False
End If
Next
m = m - 1
End Sub

Private Sub Combo1_Click()
i = Combo1.ListIndex
zs = Chr(65 + i)
End Sub
Private Sub Command1_Click()
For k = 0 To 4
tmf(k) = CInt(Text1(k))
bh(k) = Combo2(k).ListIndex
Next

End Sub

Private Sub Command2_Click()

For i = 1 To 4
Adodc1(i).Recordset.Filter = "知识点 like '" & zs & "*'"
cnt(i) = Adodc1(i).Recordset.RecordCount
Adodc1(i).Recordset.MoveFirst
For chuzhi = 1 To 25
tem(chuzhi) = 0
Next
For tmp = 1 To cnt(i)
tem(tmp) = Adodc1(i).Recordset("题号") 'tem存放满足条件 “学期”的临时记录的题号
Adodc1(i).Recordset.MoveNext
Next
tl(i) = tmf(i) \ aval(i)
If tl(i) <> 0 Then
btl(i) = True
End If
If btl(i) Then
yushu = tmf(i) - tl(i) * aval(i)
If yushu >= aval(i) \ 2 Then
tl(i) = tl(i) + 1
End If
lp: '循环
total(i) = 0
ndxs(i) = 0
trycount = trycount + 1
If trycount > 7000 Then
msg = MsgBox("超时，抽题失败,请重试", vbOK)

If msg = 1 Then
End
End If
End If
For r = 1 To tl(i)
 Randomize
rtmp(r) = Int(Rnd * cnt(i)) + 1 '试题库中对应的试题号
Adodc1(i).Recordset.MoveFirst
For j = 1 To cnt(i)
 If Adodc1(i).Recordset("题号") = tem(rtmp(r)) Then
 total(i) = total(i) + Adodc1(i).Recordset("分值")
 ndxs(i) = ndxs(i) + CInt(Adodc1(i).Recordset("难度"))
End If
 Adodc1(i).Recordset.MoveNext
Next
Next
 andxs(i) = ndxs(i) / tl(i)
 If andxs(i) > bh(i) + 2.5 And andxs(i) < bh(i) + 3.5 Then
For r = 1 To tl(i)
Adodc1(i).Recordset.MoveFirst
  For p = 1 To cnt(i)
       If tem(rtmp(r)) = Adodc1(i).Recordset("题号") Then
     tim = Adodc1(i).Recordset("题目")
   Adodc2.Recordset.AddNew
    Adodc2.Recordset("题目") = tim
    End If
   Adodc1(i).Recordset.MoveNext
    Next
  Next
  Else
  GoTo lp
  End If
  Adodc1(i).Recordset.Filter = adFilterNone
 End If
  Next
  For i = 1 To 4
  totalf = totalf + total(i)
  Next
  xztmf = (100 - totalf)
  If Abs(xztmf - tmf(0)) > 10 Then
msg = MsgBox("抽题失败，请重新设置", vbOK)
If msg = 1 Then
End
End If
 
  Else
  Adodc1(0).Recordset.Filter = "知识点 like '" & zs & "*'"
  
  cnt(0) = Adodc1(0).Recordset.RecordCount
  
  Adodc1(0).Recordset.MoveFirst
  For chuzhi = 1 To 25
 tem(chuzhi) = 0
 Next
 tl(0) = xztmf \ aval(0)
 For tmp = 1 To cnt(0)
tem(tmp) = Adodc1(0).Recordset("题号")
Adodc1(0).Recordset.MoveNext
Next
 
xlp:
xcnt = xcnt + 1
If xcnt > 10000 Then
msgx = MsgBox("不能完成选择题的抽取", vbOKOnly, "失败")
 If msgx = True Then
 End
 End If
End If
 For r = 1 To tl(0)
 Randomize
rtmp(r) = Int(Rnd * cnt(0)) + 1
Adodc1(0).Recordset.MoveFirst
For j = 1 To cnt(0)
 If Adodc1(0).Recordset("题号") = tem(rtmp(r)) Then
 ndxs(0) = ndxs(0) + CInt(Adodc1(0).Recordset("难度"))
End If
 Adodc1(0).Recordset.MoveNext
Next
Next
 andxs(0) = ndxs(0) / tl(0)
 If andxs(0) > bh(0) + 2.5 And andxs(0) < bh(0) + 3.5 Then
For r = 1 To tl(0)
Adodc1(0).Recordset.MoveFirst
  For p = 1 To cnt(0)
       If tem(rtmp(r)) = Adodc1(0).Recordset("题号") Then
     tim = Adodc1(0).Recordset("题目")
   Adodc2.Recordset.AddNew
    Adodc2.Recordset("题目") = tim
    End If
   Adodc1(0).Recordset.MoveNext
 Next
 Next
 Else
 
 GoTo xlp
 End If
 
 End If
 smsg = MsgBox("已完成抽题")
 If smsg = 1 Then
 editcmd.Enabled = True
 
  End If
 
Adodc2.Recordset.update
End Sub


Private Sub editcmd_Click()
Set Text2.DataSource = Adodc2
Text2.DataField = "题目"
Dim objWord As Object
Const CLASSOBJECT = "Word.Application"
Set objWord = CreateObject(CLASSOBJECT)
objWord.Visible = True
objWord.Documents.add
Adodc2.Recordset.MoveLast
While Adodc2.Recordset.BOF <> True
Clipboard.Clear
Clipboard.SetText Text2.Text & Chr(13)
objWord.selection.Paste
Adodc2.Recordset.MovePrevious
Wend
End Sub

Private Sub Form_Load()
aval(0) = 1
aval(1) = 20
aval(2) = 15
aval(3) = 8
aval(4) = 25
  For i = 0 To 4
  
Adodc1(i).ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\dataku.mdb;"
Next
Adodc1(0).RecordSource = "选择题"
Adodc1(1).RecordSource = "书面表达"
Adodc1(2).RecordSource = "短文改错"
Adodc1(3).RecordSource = "阅读理解"
Adodc1(4).RecordSource = "完型填空"
For i = 0 To 4
Adodc1(i).Refresh
Next
Adodc2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\tempdb.mdb;"
Adodc2.RecordSource = "temp"
Adodc2.Refresh
Image1.Picture = LoadPicture(App.Path & "\模拟考场.gif")
zj.Picture = LoadPicture(App.Path & "\bg2.gif")
End Sub

Private Sub next_Click()
For n = 0 To 2
If m + 1 = n Then
Frame1(n).Visible = True
Else
Frame1(n).Visible = False
End If
Next
m = m + 1
End Sub


Private Sub qingkong_Click()
c = Adodc2.Recordset.RecordCount
For cn = 1 To c
Adodc2.Recordset.delete
On Error GoTo 0
Next
End Sub