www.pudn.com > cjg2.rar > frmTestDIY.frm
VERSION 5.00
Begin VB.Form TestDIY
AutoRedraw = -1 'True
BorderStyle = 3 'Fixed Dialog
Caption = "手工选题"
ClientHeight = 6525
ClientLeft = 45
ClientTop = 330
ClientWidth = 10050
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 6525
ScaleWidth = 10050
ShowInTaskbar = 0 'False
Begin VB.ListBox lstProFill
Height = 2400
Left = 7155
TabIndex = 18
Top = 3575
Width = 1065
End
Begin VB.ListBox lstProRead
Height = 2400
Left = 7155
TabIndex = 16
Top = 495
Width = 1065
End
Begin VB.ListBox lstSelOne
Height = 2400
Left = 5895
TabIndex = 14
Top = 3575
Width = 1065
End
Begin VB.CommandButton cmdExit
Cancel = -1 'True
Caption = "退出"
Height = 300
Left = 7455
TabIndex = 13
Top = 6090
Width = 750
End
Begin VB.PictureBox picNavigation
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 350
Left = 1155
ScaleHeight = 345
ScaleWidth = 2415
TabIndex = 7
Top = 6105
Width = 2410
Begin VB.TextBox txtNews
Height = 270
Left = 585
Locked = -1 'True
TabIndex = 12
TabStop = 0 'False
Top = 0
Width = 1185
End
Begin VB.CommandButton cmdMove
Height = 270
Index = 2
Left = 1725
Picture = "frmTestDIY.frx":0000
Style = 1 'Graphical
TabIndex = 11
Top = 0
Width = 300
End
Begin VB.CommandButton cmdMove
Height = 270
Index = 3
Left = 2010
Picture = "frmTestDIY.frx":0044
Style = 1 'Graphical
TabIndex = 10
Top = 0
Width = 300
End
Begin VB.CommandButton cmdMove
Height = 270
Index = 0
Left = -15
Picture = "frmTestDIY.frx":0090
Style = 1 'Graphical
TabIndex = 9
Top = 0
Width = 300
End
Begin VB.CommandButton cmdMove
Height = 270
Index = 1
Left = 270
Picture = "frmTestDIY.frx":00DD
Style = 1 'Graphical
TabIndex = 8
Top = 0
Width = 300
End
End
Begin VB.CommandButton cmdOk
Caption = "确定"
Height = 300
Left = 6585
TabIndex = 6
Top = 6090
Width = 750
End
Begin VB.CommandButton cmdAdd
Caption = "添加"
Height = 300
Left = 3915
TabIndex = 5
Top = 6090
Width = 750
End
Begin VB.ListBox lstJudge
Height = 2400
Left = 5895
TabIndex = 4
Top = 495
Width = 1065
End
Begin VB.TextBox txtTest
Height = 5445
Left = 360
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 2
Top = 495
Width = 5325
End
Begin VB.ComboBox cmbType
Height = 300
ItemData = "frmTestDIY.frx":0121
Left = 1170
List = "frmTestDIY.frx":0131
Style = 2 'Dropdown List
TabIndex = 1
Top = 135
Width = 1620
End
Begin VB.Label lblPF
AutoSize = -1 'True
Caption = "Label13"
Height = 180
Index = 2
Left = 8580
TabIndex = 31
Top = 4800
Width = 630
End
Begin VB.Label Label12
AutoSize = -1 'True
Caption = "填空数为4的题"
Height = 180
Left = 8325
TabIndex = 30
Top = 4557
Width = 1170
End
Begin VB.Label lblPF
AutoSize = -1 'True
Caption = "Label11"
Height = 180
Index = 1
Left = 8580
TabIndex = 29
Top = 4314
Width = 630
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "填空数为3的题"
Height = 180
Left = 8340
TabIndex = 28
Top = 4071
Width = 1170
End
Begin VB.Label lblPF
AutoSize = -1 'True
Caption = "Label9"
Height = 180
Index = 0
Left = 8580
TabIndex = 27
Top = 3828
Width = 540
End
Begin VB.Label Label8
AutoSize = -1 'True
Caption = "填空数为2的题"
Height = 180
Left = 8325
TabIndex = 26
Top = 3585
Width = 1170
End
Begin VB.Label lblPR
AutoSize = -1 'True
Caption = "Label7"
Height = 180
Index = 2
Left = 8580
TabIndex = 25
Top = 1905
Width = 540
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "分题干数为3的题"
Height = 180
Left = 8325
TabIndex = 24
Top = 1629
Width = 1350
End
Begin VB.Label lblPR
AutoSize = -1 'True
Caption = "Label5"
Height = 180
Index = 1
Left = 8580
TabIndex = 23
Top = 1353
Width = 540
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "分题干数为2的题"
Height = 180
Left = 8325
TabIndex = 22
Top = 1077
Width = 1350
End
Begin VB.Label lblPR
Appearance = 0 'Flat
AutoSize = -1 'True
Caption = "Label3"
ForeColor = &H80000008&
Height = 180
Index = 0
Left = 8520
TabIndex = 21
Top = 801
Width = 540
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "分题干数为1的题"
Height = 180
Left = 8325
TabIndex = 20
Top = 525
Width = 1350
End
Begin VB.Label lblProFill
AutoSize = -1 'True
Caption = "程序填空题"
Height = 180
Left = 7155
TabIndex = 19
Top = 3285
Width = 900
End
Begin VB.Label lblProRead
AutoSize = -1 'True
Caption = "程序阅读题"
Height = 180
Left = 7155
TabIndex = 17
Top = 195
Width = 900
End
Begin VB.Label lblSelOne
AutoSize = -1 'True
Caption = "选择题"
Height = 180
Left = 5895
TabIndex = 15
Top = 3270
Width = 540
End
Begin VB.Label lblJudge
AutoSize = -1 'True
Caption = "判断题"
Height = 180
Left = 5895
TabIndex = 3
Top = 195
Width = 540
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "试题类型"
Height = 180
Left = 375
TabIndex = 0
Top = 195
Width = 720
End
End
Attribute VB_Name = "TestDIY"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim objTemp As New Recordset '用于保存各题型题库数据
Dim iJ%, iSO%, iPR%, iPF% '用于保存各题型小题数设置参数
Dim iDivPR%(3), iDivPF%(3), iDPR%(3), iDPF%(3) '用于保存程序阅读和程序填空题的设置参数
Dim vJ, vS, vPR, vPF '用于保存各题型选择试题的题号
Private Sub cmbType_Click()
'选择试题库
Select Case cmbType.ListIndex
Case 0
Set objTemp = objJudge.Clone
Case 1
Set objTemp = objSelOne.Clone
Case 2
Set objTemp = objProRead.Clone
Case 3
Set objTemp = objProFill.Clone
End Select
cmdMove(0).Value = True
End Sub
Private Sub cmdAdd_Click()
'根据试题类型将当前试题编号添加到选题列表中
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 iPR = iDPR(1) + iDPR(2) * 2 + iDPR(3) * 3 Then '检查是否已经选足题量
MsgBox "已经选足程序阅读题！", vbInformation, Me.Caption
Else
Add_Item lstProRead '添加程序阅读题
End If
Case 3
If iPF = iDPF(1) * 2 + iDPF(2) * 3 + iDPF(3) * 4 Then '检查是否已经选足题量
MsgBox "已经选足程序填空题！", vbInformation, Me.Caption
Else
Add_Item lstProFill '添加程序填空题
End If
End Select
End Sub
Private Sub cmdExit_Click()
Unload Me '关闭手工选题窗口
SelectTest.Show '显示试卷定制窗口
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 iPR > iDPR(1) + iDPR(2) * 2 + iDPR(3) * 3 Then
MsgBox "未选够程序阅读题，还差" _
& Trim(Str(iPR - (iDPR(1) + iDPR(2) * 2 + iDPR(3) * 3))) _
& "道题！", vbCritical, Me.Caption
ElseIf iPF > iDPF(1) * 2 + iDPF(2) * 3 + iDPF(3) * 4 Then
MsgBox "未选够程序填空题，还差" _
& Trim(Str(iPF - (iDPF(1) * 2 + iDPF(2) * 3 + iDPF(3) * 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
vS(i + 1) = Val(lstSelOne.List(i))
Next
SelectTest.SelOne = vS '使用属性过程返回选择试题
For i = 0 To lstProRead.ListCount - 1
vPR(i + 1) = Val(lstProRead.List(i))
Next
For i = lstProRead.ListCount + 1 To UBound(vPR)
vPR(i) = 0
Next
SelectTest.ProRead = vPR '使用属性过程返回选择试题
For i = 0 To lstProFill.ListCount - 1
vPF(i + 1) = Val(lstProFill.List(i))
Next
For i = lstProFill.ListCount + 1 To UBound(vPF)
vPF(i) = 0
Next
SelectTest.ProFill = vPF '使用属性过程返回选择试题
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))
iPR = Val(SelectTest.txtSum(2))
iPF = Val(SelectTest.txtSum(3))
For i = 1 To 3
iDivPR(i) = Val(SelectTest.txtDivSum(i - 1))
iDivPF(i) = Val(SelectTest.txtDivSum(i + 2))
Next
'计算已选程序阅读和程序填空的分题数
vJ = SelectTest.Judge
vS = SelectTest.SelOne
vPR = SelectTest.ProRead
vPF = SelectTest.ProFill
For i = 0 To 3
iDPR(i) = 0
iDPF(i) = 0
Next
For i = 0 To UBound(vPF)
If vPF(i) <> 0 Then
Code = Trim(Str(vPF(i)))
With objProFill
'计算选中题的分题干数
.MoveFirst
.Find "编号=" & Code & ""
m = 0
For j = 1 To 4
If .Fields("空" & Chr(96 + j)) <> "" Then m = m + 1
Next
iDPF(m - 1) = iDPF(m - 1) + 1
End With
End If
Next
For i = 0 To UBound(vPR)
If vPR(i) <> 0 Then
Code = Trim(Str(vPR(i)))
With objProRead
'计算选中题的分题干数
.MoveFirst
.Find "编号=" & Code & ""
m = 0
For j = 1 To 3
If .Fields("分题干" & Trim(Str(j))) <> "" Then m = m + 1
Next
iDPR(m) = iDPR(m) + 1
End With
End If
Next
For i = 0 To 2
lblPF(i) = "应选" & Trim(Str(iDivPF(i + 1))) & "道，差" _
& Trim(Str(iDivPF(i + 1) - iDPF(i + 1))) & "道"
lblPR(i) = "应选" & Trim(Str(iDivPR(i + 1))) & "道，差" _
& Trim(Str(iDivPR(i + 1) - iDPR(i + 1))) & "道"
Next
lblJudge = "判断题(" & SelectTest.txtSum(0) & ")"
lblSelOne = "选择题(" & SelectTest.txtSum(1) & ")"
lblProRead = "程序阅读题(" & SelectTest.txtSum(2) & ")"
lblProFill = "程序填空题(" & SelectTest.txtSum(3) & ")"
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set objTemp = Nothing
End Sub
Private Sub cmdMove_Click(Index As Integer)
With objTemp
Select Case Index '切换当前记录
Case 0 '使第一个记录成为当前记录
If .RecordCount > 0 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 Then .MoveLast
End Select
If .RecordCount < 1 Then
txtNews = "记录：无" '显示无记录提示
txtTest = ""
Else
'显示当前记录数据
Show_Data
End If
End With
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
Else
If cmbType.ListIndex = 2 Then
'计算选中题的分题干数
m = 0
For j = 1 To 3
If objTemp.Fields("分题干" & Trim(Str(j))) <> "" Then m = m + 1
Next
If iDivPR(m) = 0 Then
MsgBox "你没有设置选择分题干数为" & Trim(Str(m)) & "程序阅读题！", _
vbCritical, Me.Caption
ElseIf iDPR(m) < iDivPR(m) Then
objList.AddItem Code
iDPR(m) = iDPR(m) + 1
lblPR(m - 1) = "应选" & Trim(Str(iDivPR(m))) & "道，差" _
& Trim(Str(iDivPR(m) - iDPR(m))) & "道"
Else
MsgBox "分题干数为" & Trim(Str(m)) & "已够！", vbCritical, Me.Caption
End If
ElseIf cmbType.ListIndex = 3 Then
'计算选中题的填空数
m = 0
For j = 1 To 4
If objTemp.Fields("空" & Chr(96 + j)) <> "" Then m = m + 1
Next
If iDivPF(m - 1) = 0 Then
MsgBox "你没有设置选择填空数为" & Trim(Str(m)) & "程序填空题！", _
vbCritical, Me.Caption
ElseIf iDPF(m - 1) < iDivPF(m - 1) Then
objList.AddItem Code
iDPF(m - 1) = iDPF(m - 1) + 1
lblPF(m - 2) = "应选" & Trim(Str(iDivPF(m - 1))) & "道，差" _
& Trim(Str(iDivPF(m - 1) - iDPF(m - 1))) & "道"
Else
MsgBox "填空数为" & Trim(Str(m)) & "已够！", vbCritical, Me.Caption
End If
Else
objList.AddItem Code
End If
End If
Else
If cmbType.ListIndex = 2 Then
'计算选中题的分题干数
m = 0
For j = 1 To 3
If objTemp.Fields("分题干" & Trim(Str(j))) <> "" Then m = m + 1
Next
If iDivPR(m) = 0 Then
MsgBox "你没有设置选择填空数为" & Trim(Str(m)) & "程序填空题！", _
vbCritical, Me.Caption
Else
objList.AddItem Code
iDPR(m) = iDPR(m) + 1
lblPR(m - 1) = "应选" & Trim(Str(iDivPR(m))) & "道，差" _
& Trim(Str(iDivPR(m) - iDPR(m))) & "道"
End If
ElseIf cmbType.ListIndex = 3 Then
'计算选中题的填空数
m = 0
For j = 1 To 4
If objTemp.Fields("空" & Chr(96 + j)) <> "" Then m = m + 1
Next
If iDivPF(m - 1) = 0 Then
MsgBox "你没有设置选择填空数为" & Trim(Str(m)) & "程序填空题！", _
vbCritical, Me.Caption
Else
objList.AddItem Code
iDPF(m - 1) = iDPF(m - 1) + 1
lblPF(m - 2) = "应选" & Trim(Str(iDivPF(m - 1))) & "道，差" _
& Trim(Str(iDivPF(m - 1) - iDPF(m - 1))) & "道"
End If
Else
objList.AddItem Code
End If
End If
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 lstSelOne_Click()
'显示试题内容
cmbType.ListIndex = 1
Set objTemp = objSelOne.Clone
objTemp.Find "编号='" & lstSelOne.List(lstSelOne.ListIndex) & "'"
Show_Data
End Sub
Private Sub lstProRead_Click()
'显示试题内容
cmbType.ListIndex = 2
Set objTemp = objProRead.Clone
objTemp.Find "编号='" & lstProRead.List(lstProRead.ListIndex) & "'"
Show_Data
End Sub
Private Sub lstProFill_Click()
'显示试题内容
cmbType.ListIndex = 3
Set objTemp = objProFill.Clone
objTemp.Find "编号='" & lstProFill.List(lstProFill.ListIndex) & "'"
Show_Data
End Sub
Private Sub lstJudge_DblClick()
lstJudge.RemoveItem lstJudge.ListIndex
End Sub
Private Sub lstSelOne_DblClick()
lstSelOne.RemoveItem lstSelOne.ListIndex
End Sub
Private Sub lstProFill_DblClick()
Dim Code$, m%, i%
Code = lstProFill.List(lstProFill.ListIndex)
lstProFill.RemoveItem lstProFill.ListIndex
With objProFill
'计算选中题的分题干数
.MoveFirst
.Find "编号=" & Code & ""
m = 0
For i = 1 To 4
If .Fields("空" & Chr(96 + i)) <> "" Then m = m + 1
Next
iDPF(m - 1) = iDPF(m - 1) - 1
lblPF(m - 2) = "应选" & Trim(Str(iDivPF(m - 1))) & "道，差" _
& Trim(Str(iDivPF(m - 1) - iDPF(m - 1))) & "道"
End With
End Sub
Private Sub lstProRead_DblClick()
Dim Code$, m%, i%
Code = lstProRead.List(lstProRead.ListIndex)
lstProRead.RemoveItem lstProRead.ListIndex
With objProRead
'计算选中题的分题干数
.MoveFirst
.Find "编号=" & Code & ""
m = 0
For i = 1 To 3
If .Fields("分题干" & Trim(Str(i))) <> "" Then m = m + 1
Next
iDPR(m) = iDPR(m) - 1
lblPR(m - 1) = "应选" & Trim(Str(iDivPR(m))) & "道，差" _
& Trim(Str(iDivPR(m) - iDPF(m))) & "道"
End With
End Sub
Private Sub Show_Data()
Dim strData$
With objTemp
Select Case cmbType.ListIndex
Case 0, 3 '显示判断题或程序填空题
txtTest = "编号：" & .Fields("编号") & vbCrLf & .Fields("题干")
Case 1 '显示选择题
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")
Case 2 '显示程序阅读题
txtTest = "编号：" & .Fields("编号") & vbCrLf _
& .Fields("题干") & vbCrLf & "（1）" & .Fields("分题干1")
strData = Replace(.Fields("选项1a"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
txtTest = txtTest & vbCrLf & " （A）" & strData
strData = Replace(.Fields("选项1b"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
txtTest = txtTest & vbCrLf & " （B）" & strData
strData = Replace(.Fields("选项1c"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
txtTest = txtTest & vbCrLf & " （C）" & strData
strData = Replace(.Fields("选项1d"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
txtTest = txtTest & vbCrLf & " （D）" & strData
If .Fields("分题干2") <> "" Then
txtTest = txtTest & vbCrLf & "（2）" & .Fields("分题干2")
strData = Replace(.Fields("选项2a"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
txtTest = txtTest & vbCrLf & " （A）" & strData
strData = Replace(.Fields("选项2b"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
txtTest = txtTest & vbCrLf & " （B）" & strData
strData = Replace(.Fields("选项2c"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
txtTest = txtTest & vbCrLf & " （C）" & strData
strData = Replace(.Fields("选项2d"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
txtTest = txtTest & vbCrLf & " （D）" & strData
End If
If .Fields("分题干3") <> "" Then
If .Fields("分题干2") <> "" Then
txtTest = txtTest & vbCrLf & "（3）" & .Fields("分题干3")
Else
txtTest = txtTest & vbCrLf & "（2）" & .Fields("分题干3")
End If
strData = Replace(.Fields("选项3a"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
txtTest = txtTest & vbCrLf & " （A）" & strData
strData = Replace(.Fields("选项3b"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
txtTest = txtTest & vbCrLf & " （B）" & strData
strData = Replace(.Fields("选项3c"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
txtTest = txtTest & vbCrLf & " （C）" & strData
strData = Replace(.Fields("选项3d"), Chr(13) & Chr(10), Chr(13) & Chr(10) & Space(10))
txtTest = txtTest & vbCrLf & " （D）" & strData
End If
End Select
'显示当前记录编号和记录总数
txtNews = "记录：" & .AbsolutePosition & "/" & .RecordCount
End With
End Sub