📄 frmxz.frm
字号:
Value = 1
Width = 5295
End
End
Begin VB.Frame Frame2
Caption = "题目"
Height = 2175
Left = -74640
TabIndex = 1
Top = 360
Width = 7935
Begin VB.TextBox Txt_ti
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1815
Left = 480
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 33
Top = 240
Width = 7215
End
Begin VB.Label Lblid
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 120
TabIndex = 32
Top = 240
Width = 375
End
End
Begin VB.Data fillData
Connect = "Access"
DatabaseName = "Test.mdb"
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 495
Left = 2760
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "filldb"
Top = 4920
Width = 3375
End
End
End
Attribute VB_Name = "Frmxz"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim tinum(1 To 10) As Integer
Dim selenum(1 To 20) As Integer
Sub xianshi()
Dim j As Integer
For j = 0 To 3 '将当前四个单选按钮的颜色恢复为青兰色
Option1(j).Value = False
Option1(j).BackColor = &HFF8080
Next
'-----------------------------------------------------------------------
' 根据选择试题库显示当前记录的内容，并将考生答案转换为相应的单选项，
' 并显示为红色
'-----------------------------------------------------------------------
Lblid.Caption = rssele.Fields("se_tiid").Value
Txt_ti.Text = rssele.Fields("se_ti").Value
Txt_da(0).Text = rssele.Fields("se_dati1").Value
Txt_da(1).Text = rssele.Fields("se_dati2").Value
Txt_da(2).Text = rssele.Fields("se_dati3").Value
Txt_da(3).Text = rssele.Fields("se_dati4").Value
Select Case UCase(rssele.Fields("se_ksda").Value):
Case "A": Option1(0).Value = True
Option1(0).BackColor = &HFF&
Case "B": Option1(1).Value = True
Option1(1).BackColor = &HFF&
Case "C": Option1(2).Value = True
Option1(2).BackColor = &HFF&
Case "D": Option1(3).Value = True
Option1(3).BackColor = &HFF&
End Select
End Sub
Private Sub Cmdjj_Click()
'-----------------------------------------------------------------------
' 统计考生答完的填充题数
'-----------------------------------------------------------------------
fill = 0
Frmxz.fillData.Recordset.MoveFirst
While Not Frmxz.fillData.Recordset.EOF
If Trim(Frmxz.fillData.Recordset!fill_ksda) <> "" Then
fill = fill + 1
End If
fillData.Recordset.MoveNext
Wend
'-----------------------------------------------------------------------
' 如果考生答完全部考题，则进入考卷评分窗体Frmtj
' 否则，打开提示窗体日Frmts
'-----------------------------------------------------------------------
If sele >= 20 And fill >= 10 Then
Frmtj.Show
Else
Frmts.Show
End If
End Sub
Private Sub Cmdjs_Click()
End '退出程序
End Sub
Private Sub fillData_Reposition()
'-----------------------------------------------------------------------
'当前记录改变后，显示当前记录号
'-----------------------------------------------------------------------
fillData.Caption = "第" & Str(fillData.Recordset.AbsolutePosition + 1) & "条记录"
End Sub
Private Sub Form_Activate()
Dim i, n, num, rn As Integer
'-----------------------------------------------------------------------
'设置每题出现的顺序号
'-----------------------------------------------------------------------
fillData.Recordset.MoveLast
n = fillData.Recordset.RecordCount
'-----------------------------------------------------------------------
' 生成10道填空题出现的先后随机顺序
'-----------------------------------------------------------------------
num = 0
For i = 1 To n
tinum(i) = 0
Next i
Do While num < n
Randomize (Timer) '根据当前时间产生随机种子
rn = Int((n - 1 + 1) * Rnd + 1) '随机产生1~10之间的随机数
If tinum(rn) = 0 Then '将1~10的数赋给随机选种的题
num = num + 1
tinum(rn) = num
End If
Loop
With fillData.Recordset
.MoveFirst
For i = 1 To 10
.Edit
!fill_tiid = tinum(i)
.Update
If Not .EOF() Then
.MoveNext
End If
Next i
End With
'根据顺序号排序重新打开考试题填充库filldb
fillData.RecordSource = "Select * from filldb order by fill_tiid"
fillData.Refresh
End Sub
Private Sub Form_Load()
ChDrive App.Path
ChDir App.Path
Dim i, n, num, rn As Integer
On Error GoTo ErrMsg
CenterOnSetupForm Me
Frmxz.Caption = "考试"
sele = 0
'-----------------------------------------------------------------------
' 通过DATA控件打开考试题填空库
'-----------------------------------------------------------------------
' fillData.Connect = "Access"
' fillData.DatabaseName = "test.mdb"
' fillData.RecordSource = "filldb"
'-----------------------------------------------------------------------
' 通过DAO打开考试题选择库，设置每题出现的顺序号
'-----------------------------------------------------------------------
Set rssele = db.OpenRecordset("seleDb")
i = 0
rssele.MoveFirst
While Not rssele.EOF
i = i + 1
rssele.MoveNext
Wend
'-----------------------------------------------------------------------
' 生成20道选择题出现的先后随机顺序
'-----------------------------------------------------------------------
n = i
num = 0
For i = 1 To n
selenum(i) = 0
Next i
Do While num < n
Randomize (Timer) '根据当前时间产生随机种子
rn = Int((n - 1 + 1) * Rnd + 1) '随机产生1~20之间的随机数
If selenum(rn) = 0 Then '将1~20的数赋给随机选中的题
num = num + 1
selenum(rn) = num
End If
Loop
i = 1
rssele.MoveFirst
While Not rssele.EOF
rssele.Edit
rssele.Fields("se_tiid").Value = selenum(i)
rssele.Update
rssele.MoveNext
i = i + 1
Wend
'根据顺序号排序重新打开考试题选择库seledb
Set rssele = db.OpenRecordset(" Select * from seledb order by se_tiid")
'-----------------------------------------------------------------------
' 判断选择试题库是否存在考生答案，
' 如果有，则设置相应的题号单选按钮的颜色为红色并记数
'-----------------------------------------------------------------------
sele = 0
i = 0
While Not rssele.EOF
If Trim((rssele.Fields("se_ksda").Value)) <> "" Then
Optti(i + 1).BackColor = &HFF& '&HFF&为红色代码
sele = sele + 1
End If
rssele.MoveNext
i = i + 1
Wend
rssele.MoveFirst
xianshi '调用显示当前记录的过程
Exit Sub
ErrMsg:
MsgBox Error(Err), 48
End
End Sub
Private Sub HScroll1_Change()
Optti(HScroll1.Value).Value = True '设置选中当前的题号单选按钮，同时激活Option1_Click事件
xianshi '调用显示当前记录的过程
End Sub
Private Sub Option1_Click(Index As Integer)
Dim i, num As Integer '将当前四个单选按钮的颜色恢复为青兰色
For i = 0 To 3
Option1(i).BackColor = &HFF8080
Next
'-----------------------------------------------------------------------
' 根据考生的选择，修改相应的考生答案字段"se_ksda"，并设置选中的单选按钮
' 颜色为红色，同时统计答好的题数。
'-----------------------------------------------------------------------
rssele.Edit
Select Case Index
Case 0: rssele.Fields("se_ksda").Value = "A"
Case 1: rssele.Fields("se_ksda").Value = "B"
Case 2: rssele.Fields("se_ksda").Value = "C"
Case 3: rssele.Fields("se_ksda").Value = "D"
End Select
rssele.Update
sele = sele + 1
Option1(Index).BackColor = &HFF&
'设置当前的题号单选按钮颜色为红色来表示该题已答
Optti(rssele.AbsolutePosition + 1).BackColor = &HFF&
Optti(rssele.AbsolutePosition + 1).Value = True
End Sub
Private Sub Optti_Click(Index As Integer)
'-----------------------------------------------------------------------
' 根据考生的选中的题号单选按钮，显示相应的题目
'-----------------------------------------------------------------------
HScroll1.Value = Index
rssele.Move Index - rssele.AbsolutePosition - 1
Optti(Index).Value = True
xianshi
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -