组卷.frm

自动组卷系统,可按用户要求的难度和章节完成组卷.使用了ACCESS数据库完成.有相关论文

      Width           =   735
   End
   Begin VB.Label Label5 
      Caption         =   "题型分布"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   360
      TabIndex        =   9
      Top             =   3600
      Width           =   1335
   End
   Begin VB.Label Label4 
      Caption         =   "难度分布"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3960
      TabIndex        =   8
      Top             =   4080
      Width           =   1335
   End
   Begin VB.Label Label3 
      Caption         =   "%"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   20.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   0
      Left            =   6000
      TabIndex        =   6
      Top             =   2160
      Width           =   255
   End
   Begin VB.Label Label2 
      Caption         =   "章节分布"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   4680
      TabIndex        =   5
      Top             =   720
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "请选择章节"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   240
      TabIndex        =   1
      Top             =   840
      Width           =   1695
   End
   Begin VB.Image Image1 
      Height          =   6975
      Left            =   0
      Top             =   0
      Width           =   8055
   End
End
Attribute VB_Name = "组卷"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim zhj(1 To 10) As Integer
Dim s As Integer
Dim timu As String
Dim zhjxtotalf(1 To 10) As Integer
Dim zhjf(1 To 10) As Integer 'e各章节的分数
Dim zhjfx(1 To 10) As Integer
Dim zhjtotalf(1 To 10) As Integer
Dim vth(0 To 4, 1 To 30) As Integer
Dim szhj(1 To 10) As String
Dim z As Integer
Dim tl(0 To 4) As Integer
Dim e(0 To 4, 1 To 30) As Integer
Dim m(0 To 4, 1 To 30) As Integer
Dim h(0 To 4, 1 To 30) As Integer
Dim cnt(0 To 4) As Integer
Dim fstr As String
Dim xtotalf As Integer
Dim aval(0 To 4) As Integer

Private Sub Combo1_Click()
List1.AddItem Combo1.Text
zhj(z + 1) = Combo1.ListIndex + 1
z = z + 1
End Sub

Private Sub Command1_Click()
For ql = 0 To 2
Text2(ql).Text = ""
Text3(ql).Text = ""
Next
Text3(3).Text = ""
Text3(4).Text = ""
List1.Clear
List2.Clear
For i = 0 To 4
Adodc1(i).Recordset.Filter = adFilterNone

Next
z = 0
s = 0
End Sub


Private Sub Label14_Click()
End
End Sub

Private Sub zujuan_Click()
Dim zj As Integer
fstr = ""
 For j = 1 To z - 1
    szhj(j) = Chr(zhj(j) + 64)
  fstr = fstr & "章节分布  like '" & szhj(j) & "*'" & "or "
Next

fstr = fstr & "章节分布  like '" & Chr(zhj(j) + 64) & "*'"
L:
Data1.DatabaseName = App.Path & "\tempdb.mdb"
Data1.RecordSource = "temp"
Data1.Refresh
Data1.Database.Execute ("DELETE * FROM temp")
Data1.Database.Close

lc = lc + 1
If lc > 5000 Then
msg = MsgBox("抽题失败，请重试", vbOKCancel)
If msg = 1 Then
lc = 0
GoTo L
Else
End
End If
End If


etotalf = 0
mtotalf = 0
htotalf = 0
For s = 1 To z
zhjf(zhj(s)) = 0
Next
For i = 1 To 4
Adodc1(i).Recordset.Filter = fstr
cnt(i) = Adodc1(i).Recordset.RecordCount
tl(i) = CInt(Text3(i).Text) \ aval(i)
yushu = CInt(Text3(i).Text) Mod aval(i)
If yushu > aval(i) \ 2 Then
tl(i) = tl(i) + 1
End If
For t = 1 To tl(i)
 Randomize
 vth(i, t) = Int(Rnd * cnt(i)) + 1 '题型i中第t题的相对题号
Adodc1(i).Recordset.MoveFirst
For n = 1 To vth(i, t) - 1
 Adodc1(i).Recordset.MoveNext
 Next
 

timu = Adodc1(i).Recordset("题目")
Adodc2.Recordset.AddNew
Adodc2.Recordset("题目") = timu
 'daan = Adodc1(i).Recordset("答案")
' Adodc2.Recordset("答案") = daan
Adodc2.Recordset.update
nandustr = Adodc1(i).Recordset("难度")
 echar = Mid(nandustr, 1, 1)
 mchar = Mid(nandustr, 2, 1)
hchar = Mid(nandustr, 3, 1)
e(i, t) = CInt(echar)
m(i, t) = CInt(mchar)
h(i, t) = CInt(hchar)
zj = Asc(Adodc1(i).Recordset("章节分布")) - 64
zhjf(zj) = zhjf(zj) + Adodc1(i).Recordset("分值")
 Next
Next

For i = 1 To 4
 For t = 1 To tl(i)
 etotalf = e(i, t) + etotalf
 mtotalf = m(i, t) + mtotalf
 htotalf = h(i, t) + htotalf
 Next
 Next
 xetotalf = CInt(Text2(0).Text) - etotalf
 xmtotalf = CInt(Text2(1).Text) - mtotalf
 xhtotalf = CInt(Text2(2).Text) - htotalf
 For j = 1 To z
  zhjxtotalf(zhj(j)) = zhjtotalf(zhj(j)) - zhjf(zhj(j))
  If zhjxtotalf(zhj(j)) < 0 Then 'zhjxtotalf（zhj（j））表示要求将从各章节中抽取的选择题的总分
   GoTo L
   End If
 Next
 xtotalf = xetotalf + xmtotalf + xhtotalf
 
 If xtotalf < 0 Then
GoTo L
 End If
 Adodc1(0).Recordset.Filter = fstr
 For j = 1 To z
 zhjfx(j) = 0
Next
cnt(0) = Adodc1(0).Recordset.RecordCount
tl(0) = xtotalf \ aval(0)
xl:
For t = 1 To tl(0)
 Randomize
 vth(0, t) = Int(Rnd * cnt(0)) + 1 '题型i中第t题的相对题号
Adodc1(0).Recordset.MoveFirst
For n = 1 To vth(0, t) - 1
 Adodc1(0).Recordset.MoveNext
 Next
 timu = Adodc1(0).Recordset("题目")
Adodc2.Recordset.AddNew
Adodc2.Recordset("题目") = timu
  nandustr = Adodc1(0).Recordset("难度")
 echar = Mid(nandustr, 1, 1)
 mchar = Mid(nandustr, 2, 1)
hchar = Mid(nandustr, 3, 1)
e(0, t) = CInt(echar)
m(0, t) = CInt(mchar)
h(0, t) = CInt(hchar)
p = Asc(Adodc1(0).Recordset("章节分布")) - 64
zhjfx(p) = zhjfx(p) + Adodc1(0).Recordset("分值")
Next
xe = 0
xm = 0
xh = 0
For t = 1 To tl(0)
xe = e(0, t) + xe
xm = m(0, t) + xm
xh = h(0, t) + xh
Next
For q = 1 To z
If Abs(zhjxtotalf(zhj(q)) - zhjfx(zhj(q))) > 10 Then
b = True
Exit For
End If
Next
If Abs(xe - xetotalf) > 10 Or Abs(xm - xmtotalf) > 10 Or Abs(xhtotalf - xh) > 10 Or b Then


'tlc = tlc + 1
'If tlc > 500 Then
GoTo L
Else
'GoTo xl
'End If
'Else
msgc = MsgBox("已经成功完成抽题")
If msgc = 1 Then
editcmd.Enabled = True
End If
End If
End Sub



Private Sub Command3_Click()
End
End Sub

Private Sub Command4_Click()

Data1.DatabaseName = App.Path & "\tempdb.mdb"
Data1.RecordSource = "temp"
While Data1.Recordset.EOF <> True
Data1.Recordset.delete
Data1.Recordset.MoveNext
Wend
End Sub

Private Sub editcmd_Click()
For c = 0 To 4
ttl = ttl + tl(c)
Next

bh = 1
Dim objWord As Object
Set objWord = CreateObject("word.basic")
objWord.appshow
objWord.filenew
Adodc2.Recordset.MoveLast
objWord.Insert "第一大题 选择题" & Chr(13)
For j = 1 To ttl
If j <= tl(0) Then
objWord.Insert "(" & bh & ")" & " " & Adodc2.Recordset("题目") & Chr(13)
Else
 objWord.Insert Adodc2.Recordset("题目") & Chr(13)
 End If
If j = tl(0) Then objWord.Insert "第二大题 完型填空" & Chr(13)
If j = tl(0) + tl(4) Then objWord.Insert "第三大题 阅读理解" & Chr(13)
If j = tl(0) + tl(4) + tl(3) Then objWord.Insert "第四大题 短文改错" & Chr(13)
If j = tl(0) + tl(1) + tl(3) + tl(2) Then objWord.Insert "第五大题 书面表达" & Chr(13)
Adodc2.Recordset.MovePrevious
bh = bh + 1
Next
End Sub

Private Sub Form_Load()
Image1.Picture = LoadPicture(App.Path & "\zj.gif")
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 + "\datadb.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
Adodc1(i).Recordset.Filter = adFilterNone
Next

Adodc2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\tempdb.mdb"
Adodc2.RecordSource = "temp"
Adodc2.Refresh

End Sub


Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
List2.AddItem Text1.Text
zhjtotalf(zhj(s + 1)) = CInt(Text1.Text)
s = s + 1
Text1.Text = ""
End If
End Sub

Private Sub Text2_KeyPress(Index As Integer, KeyAscii As Integer)
 If KeyAscii = 13 Then
    If Index = 0 Then
     Text2(1).SetFocus
    Else
    If Index = 1 Then
    Text2(2).SetFocus
    Else
    If Index = 2 Then
zujuan.SetFocus
    End If
    End If
  End If
 End If
End Sub

Private Sub Text3_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
If Index < 4 Then
Text3(Index + 1).SetFocus
Else
If Index = 4 Then
Text2(0).SetFocus
End If
End If
End If
End Sub