www.pudn.com > cjg2.rar > frmSelectTest.frm
VERSION 5.00
Begin VB.Form SelectTest
BorderStyle = 1 'Fixed Single
Caption = "定制试题 "
ClientHeight = 5730
ClientLeft = 45
ClientTop = 330
ClientWidth = 6900
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 5730
ScaleWidth = 6900
Begin VB.ComboBox cmbOld
Height = 300
Left = 1680
Style = 2 'Dropdown List
TabIndex = 56
Top = 4335
Width = 2430
End
Begin VB.TextBox txtDivSum
Height = 285
Index = 5
Left = 3135
TabIndex = 54
Top = 3930
Width = 465
End
Begin VB.TextBox txtDivSum
Height = 285
Index = 4
Left = 3135
TabIndex = 51
Text = "3"
Top = 3600
Width = 465
End
Begin VB.TextBox txtDivSum
Height = 285
Index = 3
Left = 3135
TabIndex = 48
Text = "3"
Top = 3315
Width = 465
End
Begin VB.TextBox txtDivSum
Height = 285
Index = 2
Left = 3300
TabIndex = 45
Text = "3"
Top = 2595
Width = 465
End
Begin VB.TextBox txtDivSum
Height = 285
Index = 1
Left = 3300
TabIndex = 42
Text = "2"
Top = 2280
Width = 465
End
Begin VB.TextBox txtDivSum
Height = 285
Index = 0
Left = 3315
TabIndex = 39
Text = "2"
Top = 1980
Width = 465
End
Begin VB.CommandButton cmdExit
Cancel = -1 'True
Caption = "退出"
Height = 345
Left = 5070
TabIndex = 36
Top = 4920
Width = 795
End
Begin VB.CommandButton cmdDiy
Caption = "手工选题"
Height = 345
Left = 3855
TabIndex = 35
Top = 4920
Width = 1140
End
Begin VB.CommandButton cmdAuto
Caption = "机选试题"
Height = 345
Left = 2640
TabIndex = 34
Top = 4920
Width = 1140
End
Begin VB.CommandButton cmdClear
Caption = "清除"
Height = 345
Left = 1785
TabIndex = 33
Top = 4920
Width = 795
End
Begin VB.CommandButton cmdSave
Caption = "保存"
Enabled = 0 'False
Height = 345
Left = 930
TabIndex = 32
Top = 4920
Width = 795
End
Begin VB.TextBox txtScores
Height = 285
Index = 3
Left = 5055
Locked = -1 'True
TabIndex = 27
Text = "30"
Top = 2955
Width = 645
End
Begin VB.TextBox txtScore
Height = 285
Index = 3
Left = 3750
TabIndex = 26
Text = "2"
Top = 2970
Width = 645
End
Begin VB.TextBox txtSum
Height = 285
Index = 3
Left = 1935
TabIndex = 25
Text = "15"
Top = 2970
Width = 645
End
Begin VB.TextBox txtScores
Height = 285
Index = 2
Left = 5055
Locked = -1 'True
TabIndex = 24
Text = "45"
Top = 1635
Width = 645
End
Begin VB.TextBox txtScore
Height = 285
Index = 2
Left = 3750
TabIndex = 23
Text = "3"
Top = 1620
Width = 645
End
Begin VB.TextBox txtSum
Height = 285
Index = 2
Left = 1935
TabIndex = 22
Text = "15"
Top = 1605
Width = 645
End
Begin VB.TextBox txtScores
Height = 285
Index = 1
Left = 5055
Locked = -1 'True
TabIndex = 21
Text = "15"
Top = 1230
Width = 645
End
Begin VB.TextBox txtScore
Height = 285
Index = 1
Left = 3750
TabIndex = 20
Text = "1"
Top = 1230
Width = 645
End
Begin VB.TextBox txtSum
Height = 285
Index = 1
Left = 1935
TabIndex = 19
Text = "15"
Top = 1230
Width = 645
End
Begin VB.TextBox txtScores
Height = 285
Index = 0
Left = 5055
Locked = -1 'True
TabIndex = 7
Text = "10"
Top = 810
Width = 645
End
Begin VB.TextBox txtScore
Height = 285
Index = 0
Left = 3750
TabIndex = 5
Text = "1"
Top = 840
Width = 645
End
Begin VB.TextBox txtSum
Height = 285
Index = 0
Left = 1935
TabIndex = 3
Text = "10"
Top = 825
Width = 645
End
Begin VB.TextBox txtTotalScore
Height = 285
Left = 5010
MaxLength = 3
TabIndex = 1
Text = "100"
Top = 330
Width = 990
End
Begin VB.TextBox txtName
Height = 285
Left = 1665
TabIndex = 8
Top = 345
Width = 2430
End
Begin VB.Label Label31
AutoSize = -1 'True
Caption = "往届试题"
Height = 180
Left = 900
TabIndex = 55
Top = 4395
Width = 720
End
Begin VB.Label Label30
AutoSize = -1 'True
Caption = "道"
Height = 180
Left = 3660
TabIndex = 53
Top = 3975
Width = 180
End
Begin VB.Label Label29
AutoSize = -1 'True
Caption = "填空数为4的题"
Height = 180
Left = 1935
TabIndex = 52
Top = 3975
Width = 1170
End
Begin VB.Label Label28
AutoSize = -1 'True
Caption = "道"
Height = 180
Left = 3660
TabIndex = 50
Top = 3660
Width = 180
End
Begin VB.Label Label27
AutoSize = -1 'True
Caption = "填空数为3的题"
Height = 180
Left = 1935
TabIndex = 49
Top = 3660
Width = 1170
End
Begin VB.Label Label26
AutoSize = -1 'True
Caption = "道"
Height = 180
Left = 3660
TabIndex = 47
Top = 3360
Width = 180
End
Begin VB.Label Label25
AutoSize = -1 'True
Caption = "填空数为2的题"
Height = 180
Left = 1935
TabIndex = 46
Top = 3360
Width = 1170
End
Begin VB.Label Label24
AutoSize = -1 'True
Caption = "道"
Height = 180
Left = 3825
TabIndex = 44
Top = 2640
Width = 180
End
Begin VB.Label Label23
AutoSize = -1 'True
Caption = "分题干数为3的题"
Height = 180
Left = 1935
TabIndex = 43
Top = 2640
Width = 1350
End
Begin VB.Label Label22
AutoSize = -1 'True
Caption = "道"
Height = 180
Left = 3825
TabIndex = 41
Top = 2325
Width = 180
End
Begin VB.Label Label21
AutoSize = -1 'True
Caption = "分题干数为2的题"
Height = 180
Left = 1935
TabIndex = 40
Top = 2325
Width = 1350
End
Begin VB.Label Label20
AutoSize = -1 'True
Caption = "道"
Height = 180
Left = 3825
TabIndex = 38
Top = 2025
Width = 180
End
Begin VB.Label Label19
AutoSize = -1 'True
Caption = "分题干数为1的题"
Height = 180
Left = 1935
TabIndex = 37
Top = 2025
Width = 1350
End
Begin VB.Label Label16
AutoSize = -1 'True
Caption = "小题 每题"
Height = 180
Left = 2640
TabIndex = 31
Top = 3015
Width = 990
End
Begin VB.Label Label12
AutoSize = -1 'True
Caption = "小题 每题"
Height = 180
Left = 2640
TabIndex = 30
Top = 1680
Width = 990
End
Begin VB.Label Label8
AutoSize = -1 'True
Caption = "小题 每题"
Height = 180
Left = 2640
TabIndex = 29
Top = 1275
Width = 990
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "小题 每题"
Height = 180
Left = 2640
TabIndex = 28
Top = 885
Width = 990
End
Begin VB.Label Label18
AutoSize = -1 'True
Caption = "分"
Height = 180
Left = 5820
TabIndex = 18
Top = 3015
Width = 180
End
Begin VB.Label Label17
AutoSize = -1 'True
Caption = "分 共"
Height = 180
Left = 4455
TabIndex = 17
Top = 3015
Width = 540
End
Begin VB.Label Label15
AutoSize = -1 'True
Caption = "4、程序填空"
Height = 180
Left = 900
TabIndex = 16
Top = 3015
Width = 990
End
Begin VB.Label Label14
AutoSize = -1 'True
Caption = "分"
Height = 180
Left = 5820
TabIndex = 15
Top = 1680
Width = 180
End
Begin VB.Label Label13
AutoSize = -1 'True
Caption = "分 共"
Height = 180
Left = 4455
TabIndex = 14
Top = 1680
Width = 540
End
Begin VB.Label Label11
AutoSize = -1 'True
Caption = "3、程序阅读"
Height = 180
Left = 900
TabIndex = 13
Top = 1680
Width = 990
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "分"
Height = 180
Left = 5820
TabIndex = 12
Top = 1275
Width = 180
End
Begin VB.Label Label9
AutoSize = -1 'True
Caption = "分 共"
Height = 180
Left = 4455
TabIndex = 11
Top = 1275
Width = 540
End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "2、选择题"
Height = 180
Left = 900
TabIndex = 10
Top = 1275
Width = 810
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "试卷名称"
Height = 180
Left = 900
TabIndex = 9
Top = 375
Width = 720
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "分"
Height = 180
Left = 5820
TabIndex = 6
Top = 885
Width = 180
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "分 共"
Height = 180
Left = 4455
TabIndex = 4
Top = 885
Width = 540
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "1、判断题"
Height = 180
Left = 900
TabIndex = 2
Top = 885
Width = 810
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "试卷总分"
Height = 180
Left = 4230
TabIndex = 0
Top = 375
Width = 720
End
End
Attribute VB_Name = "SelectTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim objCn As New Connection, objOld As Recordset
Dim iJudge() As Integer, iSelOne() As Integer
Dim iProRead() As Integer, iProFill() As Integer
Dim isSaved As Boolean
Private Sub cmbOld_Click()
Dim iTotal%, objTemp As New Recordset, m%, j%, i%
Dim sJ$, sSO$, sPR$, sPF$, vJ, vSO, vPR, vPF
If cmbOld.ListIndex > 0 Then
'清除窗体中原有显示数据
For i = 0 To 3
txtSum(i) = "": txtScore(i) = ""
Next
For i = 0 To 5
txtDivSum(i) = ""
Next
'访问数据库，获得选中试卷的试题数据
If objCn.State = adStateClosed Then objCn.Open
With objTemp
Set .ActiveConnection = objCn
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.Open "select * from " & cmbOld
If .RecordCount > 0 Then
.MoveFirst
While Not .EOF
Select Case .Fields("题型")
Case "判断题"
txtScore(0) = Trim(Str(.Fields("分数")))
txtSum(0) = Trim(Str(Val(txtSum(0)) + 1))
sJ = sJ & "," & Trim(Str(.Fields("编号")))
Case "选择题"
txtScore(1) = Trim(Str(.Fields("分数")))
txtSum(1) = Trim(Str(Val(txtSum(1)) + 1))
sSO = sSO & "," & Trim(Str(.Fields("编号")))
Case "程序阅读"
txtScore(2) = Trim(Str(.Fields("分数")))
'计算选中题的分题干数
objProRead.MoveFirst
objProRead.Find "编号=" & Str(.Fields("编号"))
m = 0
For j = 1 To 3
If objProRead.Fields("分题干" & Trim(Str(j))) <> "" Then _
m = m + 1
Next
txtDivSum(m - 1) = Trim(Str(Val(txtDivSum(m - 1)) + 1))
sPR = sPR & "," & Trim(Str(.Fields("编号")))
Case "程序填空"
txtScore(3) = Trim(Str(.Fields("分数")))
'计算选中题的填空数
objProFill.MoveFirst
objProFill.Find "编号=" & Str(.Fields("编号"))
m = 0
For j = 1 To 4
If objProFill.Fields("空" & Chr(j + 96)) <> "" Then _
m = m + 1
Next
txtDivSum(m + 1) = Trim(Str(Val(txtDivSum(m + 1)) + 1))
sPF = sPF & "," & Trim(Str(.Fields("编号")))
End Select
.MoveNext
Wend
'显示小题数
txtSum(2) = Trim(Str(Val(txtDivSum(0)) + Val(txtDivSum(1)) * 2 _
+ Val(txtDivSum(2)) * 3))
txtSum(3) = Trim(Str(Val(txtDivSum(3)) * 2 + Val(txtDivSum(4)) * 3 _
+ Val(txtDivSum(5)) * 4))
txtTotalScore = Trim(Str(Val(txtScores(0)) + Val(txtScores(1)) _
+ Val(txtScores(2)) + Val(txtScores(3))))
'获得试题数据
vJ = Split(sJ, ",")
vSO = Split(sSO, ",")
vPR = Split(sPR, ",")
vPF = Split(sPF, ",")
ReDim iJudge(UBound(vJ))
For i = 0 To UBound(vJ)
iJudge(i) = Val(vJ(i))
Next
ReDim iSelOne(UBound(vSO))
For i = 0 To UBound(vSO)
iSelOne(i) = Val(vSO(i))
Next
ReDim iProRead(UBound(vPR))
For i = 0 To UBound(vPR)
iProRead(i) = Val(vPR(i))
Next
ReDim iProFill(UBound(vPF))
For i = 0 To UBound(vPF)
iProFill(i) = Val(vPF(i))
Next
End If
.Close
End With
Set objTemp = Nothing
End If
End Sub
Private Sub cmdAuto_Click()
Dim i%, j%, s%, n%, m%, iPRS%(3), iPFS%(3)
'检验试题设置是否正确
If Check_Seting() = False Then Exit Sub
'根据小题数量定义数组大小
ReDim iJudge(Val(txtSum(0)))
ReDim iSelOne(Val(txtSum(1)))
ReDim iProRead(Val(txtSum(2)))
ReDim iProFill(Val(txtSum(3)))
'随机产生判断题
For i = 1 To Val(txtSum(0))
With objJudge
n = Int(Rnd * .RecordCount + 1) '随机产生一个记录号
'获得试题编号
.MoveFirst
.Move n - 1, adBookmarkFirst
n = .Fields("编号")
'检查试题编号是否重复
For j = 1 To i - 1
If iJudge(j) = n Then Exit For
Next
If j < i Then
i = i - 1 '重新抽取题号
Else
iJudge(i) = n '保存未重复的题号
End If
End With
Next
'随机产生选择题
For i = 1 To Val(txtSum(1))
With objSelOne
n = Int(Rnd * .RecordCount + 1) '随机产生一个记录号
'获得试题编号
.MoveFirst
.Move n - 1, adBookmarkFirst
n = .Fields("编号")
'检查试题编号是否重复
For j = 1 To i - 1
If iSelOne(j) = n Then Exit For
Next
If j < i Then
i = i - 1 '重新抽取题号
Else
iSelOne(i) = n '保存未重复的题号
End If
End With
Next
'随机产生程序阅读题
s = 1
For i = 1 To Val(txtSum(2))
With objProRead
n = Int(Rnd * .RecordCount + 1) '随机产生一个记录号
'获得试题编号
.MoveFirst
.Move n - 1, adBookmarkFirst
n = .Fields("编号")
'检查试题编号是否重复
For j = 1 To i - 1
If iProRead(j) = n Then Exit For
Next
If j < i Then
i = i - 1 '重新抽取题号
Else
'计算选中题的分题干数
m = 0
For j = 1 To 3
If .Fields("分题干" & Trim(Str(j))) <> "" Then m = m + 1
Next
If iPRS(m) < Val(txtDivSum(m - 1)) Then
iProRead(s) = n '保存未重复的题号
s = s + 1
iPRS(m) = iPRS(m) + 1
i = i + m - 1
Else
i = i - 1 '重新抽取题号
End If
End If
End With
Next
'随机产生程序阅读题
s = 1
For i = 1 To Val(txtSum(3))
With objProFill
n = Int(Rnd * .RecordCount + 1) '随机产生一个记录号
'获得试题编号
.MoveFirst
.Move n - 1, adBookmarkFirst
n = .Fields("编号")
'检查试题编号是否重复
For j = 1 To i - 1
If iProFill(j) = n Then Exit For
Next
If j < i Then
i = i - 1 '重新抽取题号
Else
'检查选中题的填空数
m = 0
For j = 1 To 4
If .Fields("空" & Chr(j + 96)) <> "" Then m = m + 1
Next
If iPFS(m - 2) < Val(txtDivSum(m + 1)) Then
iProFill(s) = n '保存未重复的题号
s = s + 1
iPFS(m - 2) = iPFS(m - 2) + 1
i = i + m - 1
Else
i = i - 1 '重新抽取题号
End If
End If
End With
Next
'打开手工选题窗口，显示已选试题
For i = 1 To Val(txtSum(0))
TestDIY.lstJudge.AddItem Trim(Str(iJudge(i)))
Next
For i = 1 To Val(txtSum(1))
TestDIY.lstSelOne.AddItem Trim(Str(iSelOne(i)))
Next
For i = 1 To Val(txtSum(2))
If iProRead(i) = 0 Then Exit For
TestDIY.lstProRead.AddItem Trim(Str(iProRead(i)))
Next
i = 1
For i = 1 To Val(txtSum(3))
If iProFill(i) = 0 Then Exit For
TestDIY.lstProFill.AddItem Trim(Str(iProFill(i)))
Next
Me.Hide '隐藏试卷定制窗体
TestDIY.Show '显示手工选题窗体
cmdSave.Enabled = True
End Sub
Private Sub cmdClear_Click()
Dim i%
txtName = ""
isSaved = False
cmdSave.Enabled = False
End Sub
Private Sub cmdDiy_Click()
Dim i%, s%
'检验试题设置是否正确
If Check_Seting() = False Then Exit Sub
'根据小题数量定义数组大小
ReDim Preserve iJudge(Val(txtSum(0)))
ReDim Preserve iSelOne(Val(txtSum(1)))
ReDim Preserve iProRead(Val(txtSum(2)))
ReDim Preserve iProFill(Val(txtSum(3)))
'显示手工选题窗口
For i = 1 To Val(txtSum(0))
If iJudge(i) = 0 Then Exit For
TestDIY.lstJudge.AddItem Trim(Str(iJudge(i)))
Next
For i = 1 To Val(txtSum(1))
If iSelOne(i) = 0 Then Exit For
TestDIY.lstSelOne.AddItem Trim(Str(iSelOne(i)))
Next
For i = 1 To Val(txtSum(2))
If iProRead(i) = 0 Then Exit For
TestDIY.lstProRead.AddItem Trim(Str(iProRead(i)))
Next
i = 1
For i = 1 To Val(txtSum(3))
If iProFill(i) = 0 Then Exit For
TestDIY.lstProFill.AddItem Trim(Str(iProFill(i)))
Next
Me.Hide '隐藏试卷定制窗体
TestDIY.Show '显示手工选题窗体
cmdSave.Enabled = True
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdSave_Click()
'检查是否根据设置选择了试题
Dim i%
On Error GoTo DealError
Dim strSQL$
If iJudge(1) = 0 Then
MsgBox "没有根据设置选择试题！", vbCritical, Me.Caption
ElseIf Trim(txtName) = "" Then
MsgBox "请输入试题名称！", vbCritical, Me.Caption
txtName.SetFocus
txtName = ""
Else
With objCn
If .State = adStateClosed Then .Open
If Not isSaved Then
'创建试题库，保存试题
strSQL = "Create Table " & Trim(txtName) _
& " ( 编号 int not null, 题型 varchar(8) not null, 分数 tinyint not null)"
.Execute strSQL
strSQL = "INSERT INTO 历届试题 (表名) VALUES ('" & Trim(txtName) & "')"
.Execute strSQL
Else
If MsgBox("是否重新保存试题？", vbQuestion + _
vbYesNo, Me.Caption) = vbYes Then
'删除原有试题
strSQL = "delete " & Trim(txtName) & " "
.Execute strSQL
Else
.Close
Exit Sub
End If
End If
'保存试题
For i = 1 To UBound(iJudge)
If iJudge(i) = 0 Then Exit For
strSQL = "INSERT INTO " & Trim(txtName) & _
" (编号,题型,分数) VALUES (" & Str(iJudge(i)) & ",'判断题'," _
& txtScore(0) & ")"
.Execute strSQL
Next
For i = 1 To UBound(iSelOne)
If iSelOne(i) = 0 Then Exit For
strSQL = "INSERT INTO " & Trim(txtName) & _
" (编号,题型,分数) VALUES (" & Str(iSelOne(i)) & ",'选择题'," _
& txtScore(1) & ")"
.Execute strSQL
Next
For i = 1 To UBound(iProRead)
If iProRead(i) = 0 Then Exit For
strSQL = "INSERT INTO " & Trim(txtName) & _
" (编号,题型,分数) VALUES (" & Str(iProRead(i)) & ",'程序阅读'," _
& txtScore(2) & ")"
.Execute strSQL
Next
For i = 1 To UBound(iProFill)
If iProFill(i) = 0 Then Exit For
strSQL = "INSERT INTO " & Trim(txtName) & _
" (编号,题型,分数) VALUES (" & Str(iProFill(i)) & ",'程序填空'," _
& txtScore(3) & ")"
.Execute strSQL
Next
MsgBox "成功保存试题！"
'刷新往届试题列表
Set objOld.ActiveConnection = objCn
If objOld.State = adStateClosed Then objOld.Open
objOld.Requery
cmbOld.Clear
cmbOld.AddItem ""
If objOld.RecordCount > 0 Then
objOld.MoveFirst
While Not objOld.EOF
cmbOld.AddItem objOld.Fields("表名")
objOld.MoveNext
Wend
End If
isSaved = True
If .State = adStateOpen Then .Close
End With
End If
Exit Sub
DealError:
'处理可能产生的错误
If Err.Number = -2147217900 Then
MsgBox "程序执行出错：请修改试题名称后再尝试保存操作！", vbCritical, Me.Caption
txtName.SetFocus
If objCn.State = adStateOpen Then objCn.Close
If objOld.State = adStateOpen Then objOld.Close
Else
MsgBox Err.Description, vbCritical, Me.Caption
If objCn.State = adStateOpen Then objCn.Close
If objOld.State = adStateOpen Then objOld.Close
End If
End Sub
Private Sub Form_Load()
With objCn '建立数据库联接
.Provider = "SQLOLEDB"
.ConnectionString = "User ID=sa;PWD=123;Data Source=(local);Initial Catalog=自测考试"
.Open
End With
'访问数据库获得判断题数据
Set objJudge = New Recordset '实例化对象
With objJudge
Set .ActiveConnection = objCn '建立数据库连接
.CursorLocation = adUseClient '指定使用客户端游标
.CursorType = adOpenStatic '指定使用静态游标
.Open "SELECT * FROM 判断题" '获取判断题数据
Set .ActiveConnection = Nothing '断开数据库连接
End With
'访问数据库获得单项选择题数据
Set objSelOne = New Recordset '实例化对象
With objSelOne
Set .ActiveConnection = objCn '建立数据库连接
.CursorLocation = adUseClient '指定使用客户端游标
.CursorType = adOpenStatic '指定使用静态游标
.Open "SELECT * FROM 选择题" '获取选择题数据
Set .ActiveConnection = Nothing '断开数据库连接
End With
'访问数据库获得程序阅读题数据
Set objProRead = New Recordset '实例化对象
With objProRead
Set .ActiveConnection = objCn '建立数据库连接
.CursorLocation = adUseClient '指定使用客户端游标
.CursorType = adOpenStatic '指定使用静态游标
.Open "SELECT * FROM 程序阅读" '获取程序阅读题数据
Set .ActiveConnection = Nothing '断开数据库连接
End With
'访问数据库获得程序填空题数据
Set objProFill = New Recordset '实例化对象
With objProFill
Set .ActiveConnection = objCn '建立数据库连接
.CursorLocation = adUseClient '指定使用客户端游标
.CursorType = adOpenStatic '指定使用静态游标
.Open "SELECT * FROM 程序填空" '获取程序填空题数据
Set .ActiveConnection = Nothing '断开数据库连接
End With
'访问数据库获得历届试题数据
Set objOld = New Recordset '实例化对象
With objOld
Set .ActiveConnection = objCn '建立数据库连接
.CursorLocation = adUseClient '指定使用客户端游标
.CursorType = adOpenStatic '指定使用静态游标
.Open "SELECT * FROM 历届试题" '获取历届试题数据
Set .ActiveConnection = Nothing '断开数据库连接
cmbOld.AddItem ""
If .RecordCount > 0 Then
.MoveFirst
While Not .EOF
cmbOld.AddItem .Fields("表名")
.MoveNext
Wend
End If
End With
objCn.Close '关闭数据库连接
End Sub
Private Sub Form_Unload(Cancel As Integer)
'释放数据库连接和记录集对象
Set objCn = Nothing
Set objOld = Nothing
Set objJudge = Nothing
Set objSelOne = Nothing
Set objProRead = Nothing
Set objProFill = Nothing
End Sub
Private Sub txtScore_Change(Index As Integer)
If Val(txtSum(Index)) <> 0 Then
txtScores(Index) = Val(txtSum(Index)) * Val(txtScore(Index))
End If
End Sub
Private Sub txtSum_Change(Index As Integer)
If Val(txtScore(Index)) <> 0 Then
txtScores(Index) = Val(txtSum(Index)) * Val(txtScore(Index))
End If
End Sub
'检验小题分值输入
Private Sub txtScore_KeyPress(Index As Integer, KeyAscii As Integer)
If Not (Chr(KeyAscii) Like "[0-9]" Or KeyAscii = vbKeyBack) Then
KeyAscii = 0 '输入不是数字或退格键，取消输入
End If
End Sub
'检验小题数量输入
Private Sub txtSum_KeyPress(Index As Integer, KeyAscii As Integer)
If Not (Chr(KeyAscii) Like "[0-9]" Or KeyAscii = vbKeyBack) Then
KeyAscii = 0 '输入不是数字或退格键，取消输入
End If
End Sub
'检验总分输入
Private Sub txtTotalScore_KeyPress(KeyAscii As Integer)
If Not (Chr(KeyAscii) Like "[0-9]" Or KeyAscii = vbKeyBack) Then
KeyAscii = 0 '输入不是数字或退格键，取消输入
End If
End Sub
'判断题数据访问属性过程
Public Property Get Judge() As Variant
Judge = iJudge
End Property
Public Property Let Judge(iNew As Variant)
iJudge = iNew
End Property
'选择题数据访问属性过程
Public Property Get SelOne() As Variant
SelOne = iSelOne
End Property
Public Property Let SelOne(iNew As Variant)
iSelOne = iNew
End Property
'程序阅读题题数据访问属性过程
Public Property Get ProRead() As Variant
ProRead = iProRead
End Property
Public Property Let ProRead(iNew As Variant)
iProRead = iNew
End Property
'程序填空题数据访问属性过程
Public Property Get ProFill() As Variant
ProFill = iProFill
End Property
Public Property Let ProFill(iNew As Variant)
iProFill = iNew
End Property
Private Function Check_Seting() As Boolean
Dim i%, s%
Check_Seting = False
'检查是否正确的设置了各类型题的小题数和分数
For i = 0 To 3
If Val(txtSum(i)) = 0 Then
MsgBox "请设置正确的小题数量！", vbCritical, Me.Caption
txtSum(i).SetFocus
Exit Function
ElseIf Val(txtScore(i)) = 0 Then
MsgBox "请设置正确的小题分数！", vbCritical, Me.Caption
txtScore(i).SetFocus
Exit Function
End If
s = s + Val(txtScores(i))
Next
'检查小题分数合计与总分是否一致
If Val(txtTotalScore) <> Val(s) Then
MsgBox "小题分数合计与试卷总分不一致！", vbCritical, Me.Caption
Exit Function
End If
'检验程序阅读分题干数设置是否正确
If Val(txtDivSum(0)) + Val(txtDivSum(1)) * 2 + Val(txtDivSum(2)) * 3 <> Val(txtSum(2)) Then
MsgBox "程序阅读题分题干数设置不正确！", vbCritical, Me.Caption
txtDivSum(0).SetFocus
Exit Function
End If
'检验程序填空题分题干数设置是否正确
If Val(txtDivSum(3)) * 2 + Val(txtDivSum(4)) * 3 + Val(txtDivSum(5)) * 4 <> Val(txtSum(3)) Then
MsgBox "程序填空题分题干数设置不正确！", vbCritical, Me.Caption
txtDivSum(3).SetFocus
Exit Function
End If
Check_Seting = True
End Function