www.pudn.com > cjg2.rar > frmToScoring.frm
VERSION 5.00
Begin VB.Form ToScoring
BorderStyle = 1 'Fixed Single
Caption = "试卷评阅"
ClientHeight = 6330
ClientLeft = 45
ClientTop = 330
ClientWidth = 10665
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 6330
ScaleWidth = 10665
Begin VB.Frame frmTeacher
Caption = "Frame3"
Height = 990
Left = 4951
TabIndex = 34
Top = 5048
Width = 5310
Begin VB.CommandButton cmdExit
Caption = "退出"
Height = 300
Left = 3855
TabIndex = 39
Top = 420
Width = 870
End
Begin VB.TextBox txtNum
Height = 300
Left = 2100
Locked = -1 'True
TabIndex = 38
Top = 555
Width = 1230
End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "当前试卷"
Height = 180
Left = 2100
TabIndex = 37
Top = 330
Width = 720
End
Begin VB.Label lblChecked
AutoSize = -1 'True
Caption = "已阅份数："
Height = 180
Left = 225
TabIndex = 36
Top = 630
Width = 900
End
Begin VB.Label lblTotal
AutoSize = -1 'True
Caption = "剩余份数："
Height = 180
Left = 240
TabIndex = 35
Top = 330
Width = 900
End
End
Begin VB.Frame Frame2
Caption = "试卷得分"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 4395
Left = 8098
TabIndex = 24
Top = 578
Width = 2160
Begin VB.CommandButton cmdSubmit
Caption = "提交"
Height = 300
Left = 645
TabIndex = 33
Top = 3660
Width = 870
End
Begin VB.TextBox txtScore
Height = 300
Index = 3
Left = 255
Locked = -1 'True
TabIndex = 32
Top = 2940
Width = 1650
End
Begin VB.TextBox txtScore
Height = 300
Index = 2
Left = 240
Locked = -1 'True
TabIndex = 31
Top = 2220
Width = 1650
End
Begin VB.TextBox txtScore
Height = 300
Index = 1
Left = 240
Locked = -1 'True
TabIndex = 30
Top = 1500
Width = 1650
End
Begin VB.TextBox txtScore
Height = 300
Index = 0
Left = 240
Locked = -1 'True
TabIndex = 29
Top = 780
Width = 1650
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "四、程序填空"
Height = 180
Left = 240
TabIndex = 28
Top = 2670
Width = 1080
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "三、程序阅读"
Height = 180
Left = 240
TabIndex = 27
Top = 1965
Width = 1080
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "二、选择题"
Height = 180
Left = 240
TabIndex = 26
Top = 1260
Width = 900
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "一、判断题"
Height = 180
Left = 240
TabIndex = 25
Top = 555
Width = 900
End
End
Begin VB.Frame Frame1
Caption = "程序填空学生答题"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 4395
Left = 4951
TabIndex = 7
Top = 578
Width = 3060
Begin VB.Frame frmBlank
Caption = "第4空"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 960
Index = 3
Left = 135
TabIndex = 20
Top = 3315
Width = 2820
Begin VB.OptionButton optYN4
Caption = "错误"
Height = 225
Index = 1
Left = 1290
TabIndex = 23
Top = 645
Width = 705
End
Begin VB.OptionButton optYN4
Caption = "正确"
Height = 225
Index = 0
Left = 495
TabIndex = 22
Top = 645
Width = 705
End
Begin VB.TextBox txtStuAnswer
Height = 300
Index = 3
Left = 105
Locked = -1 'True
TabIndex = 21
Top = 255
Width = 2640
End
End
Begin VB.Frame frmBlank
Caption = "第3空"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 960
Index = 2
Left = 135
TabIndex = 16
Top = 2315
Width = 2820
Begin VB.TextBox txtStuAnswer
Height = 300
Index = 2
Left = 120
Locked = -1 'True
TabIndex = 19
Top = 300
Width = 2640
End
Begin VB.OptionButton optYN3
Caption = "正确"
Height = 225
Index = 0
Left = 525
TabIndex = 18
Top = 645
Width = 705
End
Begin VB.OptionButton optYN3
Caption = "错误"
Height = 225
Index = 1
Left = 1290
TabIndex = 17
Top = 645
Width = 705
End
End
Begin VB.Frame frmBlank
Caption = "第2空"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 960
Index = 1
Left = 135
TabIndex = 12
Top = 1315
Width = 2820
Begin VB.TextBox txtStuAnswer
Height = 300
Index = 1
Left = 105
Locked = -1 'True
TabIndex = 15
Top = 285
Width = 2640
End
Begin VB.OptionButton optYN2
Caption = "正确"
Height = 225
Index = 0
Left = 495
TabIndex = 14
Top = 645
Width = 705
End
Begin VB.OptionButton optYN2
Caption = "错误"
Height = 225
Index = 1
Left = 1290
TabIndex = 13
Top = 645
Width = 705
End
End
Begin VB.Frame frmBlank
Caption = "第1空"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 990
Index = 0
Left = 135
TabIndex = 8
Top = 315
Width = 2820
Begin VB.OptionButton optYN1
Caption = "错误"
Height = 225
Index = 1
Left = 1290
TabIndex = 11
Top = 675
Width = 705
End
Begin VB.OptionButton optYN1
Caption = "正确"
Height = 225
Index = 0
Left = 510
TabIndex = 10
Top = 690
Width = 705
End
Begin VB.TextBox txtStuAnswer
Height = 300
Index = 0
Left = 120
Locked = -1 'True
TabIndex = 9
Top = 300
Width = 2640
End
End
End
Begin VB.PictureBox picNavigation
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 345
Left = 837
ScaleHeight = 345
ScaleWidth = 3600
TabIndex = 2
Top = 5693
Width = 3600
Begin VB.CommandButton cmdMove
Caption = "后一题"
Height = 300
Index = 2
Left = 1810
Style = 1 'Graphical
TabIndex = 6
Top = 15
Width = 870
End
Begin VB.CommandButton cmdMove
Caption = "末尾题"
Height = 300
Index = 3
Left = 2700
Style = 1 'Graphical
TabIndex = 5
Top = 15
Width = 870
End
Begin VB.CommandButton cmdMove
Caption = "第一题"
Height = 300
Index = 0
Left = 30
Style = 1 'Graphical
TabIndex = 4
Top = 15
Width = 870
End
Begin VB.CommandButton cmdMove
Caption = "前一题"
Height = 300
Index = 1
Left = 920
Style = 1 'Graphical
TabIndex = 3
Top = 15
Width = 870
End
End
Begin VB.TextBox txtTest
Height = 5070
Left = 410
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 578
Width = 4455
End
Begin VB.Label lblType
AutoSize = -1 'True
Caption = "程序填空及参考答案"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 403
TabIndex = 1
Top = 293
Width = 2025
End
End
Attribute VB_Name = "ToScoring"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim objTest As Recordset '用于保存考试记录数据
Dim objJudge As Recordset '用于保存判断题题库数据
Dim objSelOne As Recordset '用于保存选择题题库数据
Dim objProRead As Recordset '用于保存程序阅读题题库数据
Dim objProFill As Recordset '用于保存程序填空题题库数据
Dim objCn As Connection '用于建立数据库连接
Dim objTeacher As Recordset '用于保存阅卷教师数据
Dim strTest '用于表存学生答题信息
Dim iTestNo% '用于保存当前题号
Dim iRight%() '用于保存程序填空题的评阅结果
Dim iPFS% '用于保存程序填空题的小题分数
Dim StuCode$ '用于保存当前试卷学生的考号
Private Sub cmdSubmit_Click()
Dim i%, j%, k%
Dim strSQL$
i = Val(txtScore(0)) + Val(txtScore(1)) + Val(txtScore(2)) + Val(txtScore(3))
If MsgBox("本试卷总分：" & Str(i) & "，提交？", vbQuestion + vbYesNo, _
"教师阅卷") = vbNo Then Exit Sub
'保存当前学生试卷成绩
strSQL = "update 学生信息 set 成绩=" & Str(i) _
& " where 考号='" & StuCode & "'"
objCn.Execute strSQL
'保存阅卷记录
strSQL = "Insert Into 阅卷记录 (教师,考号) Values (" _
& Str(objTeacher.Fields("编号")) & ",'" & StuCode & "')"
objCn.Execute strSQL
MsgBox "成绩提交成功！", vbInformation, "教师阅卷"
'更新教师阅卷信息
lblTotal = "剩余份数：" & Str(Val(Mid(lblTotal, 6)) - 1)
lblChecked = "已阅份数：" & Str(Val(Mid(lblChecked, 6)) + 1)
txtNum = Str(Val(txtNum) + 1)
'获得下一份试卷
With objTest
.Close
Set .ActiveConnection = objCn '建立数据库连接
.Open "SELECT TOP 1 考试记录.* FROM 考试记录,学生信息 " _
& " WHERE 考试记录.考号=学生信息.考号 and 成绩 is null"
Set .ActiveConnection = Nothing '断开数据库连接
If .RecordCount = 0 Then
MsgBox "试卷已经评阅完毕！"
picNavigation.Enabled = False
cmdSubmit.Enabled = False
Exit Sub
End If
StuCode = .Fields("考号")
End With
Get_Test_Data
iTestNo = 0
ReDim iRight(UBound(strTest))
'设置默认值
For i = 0 To UBound(strTest)
iRight(i) = -1
Next
cmdMove(0).Value = True
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim i%
Set objCn = New Connection
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 '指定使用客户端游标
.Open "SELECT * FROM 判断题" '获取判断题数据
Set .ActiveConnection = Nothing '断开数据库连接
End With
'访问数据库获得单项选择题数据
Set objSelOne = New Recordset '实例化对象
With objSelOne
Set .ActiveConnection = objCn '建立数据库连接
.CursorLocation = adUseClient '指定使用客户端游标
.Open "SELECT * FROM 选择题" '获取选择题数据
Set .ActiveConnection = Nothing '断开数据库连接
End With
'访问数据库获得程序阅读题数据
Set objProRead = New Recordset '实例化对象
With objProRead
Set .ActiveConnection = objCn '建立数据库连接
.CursorLocation = adUseClient '指定使用客户端游标
.Open "SELECT * FROM 程序阅读" '获取程序阅读题数据
Set .ActiveConnection = Nothing '断开数据库连接
End With
'访问数据库获得程序填空题数据
Set objProFill = New Recordset '实例化对象
With objProFill
Set .ActiveConnection = objCn '建立数据库连接
.CursorLocation = adUseClient '指定使用客户端游标
.Open "SELECT * FROM 程序填空" '获取程序填空题数据
Set .ActiveConnection = Nothing '断开数据库连接
iPFS = .Fields("分数")
End With
'访问数据库获得第一份批改试卷数据
Set objTest = New Recordset '实例化对象
With objTest
Set .ActiveConnection = objCn '建立数据库连接
.CursorLocation = adUseClient '指定使用客户端游标
.Open "SELECT TOP 1 考试记录.* FROM 考试记录,学生信息 " _
& " WHERE 考试记录.考号=学生信息.考号 and 成绩 is null"
Set .ActiveConnection = Nothing '断开数据库连接
If .RecordCount = 0 Then
MsgBox "试卷已经评阅完毕！"
Frame2.Enabled = False
picNavigation.Enabled = False
cmdSubmit.Enabled = False
Exit Sub
End If
StuCode = .Fields("考号")
End With
'访问数据库获得阅卷教师信息
Set objTeacher = New Recordset '实例化对象
With objTeacher
Set .ActiveConnection = objCn '建立数据库连接
.CursorLocation = adUseClient '指定使用客户端游标
.Open "SELECT * FROM 阅卷教师 where 姓名='" & CurrentUserName & "'" '获得阅卷教师信息
Set .ActiveConnection = Nothing '断开数据库连接
If .RecordCount = 0 Then
MsgBox "请以阅卷教师身份登录系统，否则不能正常使用阅卷功能！", , Me.Caption
Frame2.Enabled = False
picNavigation.Enabled = False
cmdSubmit.Enabled = False
Exit Sub
End If
frmTeacher.Caption = CurrentUserName & "阅卷信息"
lblTotal = "剩余份数：" & .Fields("数量")
lblChecked = "已阅份数：0"
txtNum = "1"
End With
'显示试卷程序填空题以及客观分数
Get_Test_Data
iTestNo = 0
ReDim iRight(UBound(strTest))
'设置默认值
For i = 0 To UBound(strTest)
iRight(i) = -1
Next
cmdMove(0).Value = True
End Sub
Private Sub cmdMove_Click(Index As Integer)
Dim n, Code$(3), Answer$(3)
'该变当前程序填空题
Select Case Index
Case 0 '使第一题成为当前题
If iTestNo <> 0 Then iTestNo = 0
Case 1 '使上一题成为当前题
iTestNo = iTestNo - 4
If iTestNo < 0 Then iTestNo = 0
Case 2 '使下一个记录成为当前题
iTestNo = iTestNo + 4
If iTestNo > UBound(strTest) Then iTestNo = UBound(strTest) - 3
Case 3 '使最后一题成为当前题
iTestNo = UBound(strTest) - 3
End Select
n = InStr(strTest(iTestNo), "=")
Code(0) = Left(strTest(iTestNo), n - 1)
Answer(0) = Mid(strTest(iTestNo), n + 1)
n = InStr(strTest(iTestNo + 1), "=")
Code(1) = Left(strTest(iTestNo + 1), n - 1)
Answer(1) = Mid(strTest(iTestNo + 1), n + 1)
n = InStr(strTest(iTestNo + 2), "=")
Code(2) = Left(strTest(iTestNo + 2), n - 1)
Answer(2) = Mid(strTest(iTestNo + 2), n + 1)
n = InStr(strTest(iTestNo + 3), "=")
Code(3) = Left(strTest(iTestNo + 3), n - 1)
Answer(3) = Mid(strTest(iTestNo + 3), n + 1)
For n = 0 To 3
txtStuAnswer(n) = Answer(n)
Next
'显示程序填空题及参考答案
With objProFill
.MoveFirst
.Find "编号=" & Code(0)
txtTest = "【" & Trim(Str(iTestNo / 4 + 1)) & "】" & vbCrLf _
& .Fields("题干") & vbCrLf & "第1空参考答案：" & .Fields("空a") _
& vbCrLf & "第2空参考答案：" & .Fields("空b")
If .Fields("空c") <> "" Then
txtTest = txtTest & vbCrLf & "第3空参考答案：" & .Fields("空c")
frmBlank(2).Visible = True
Else
frmBlank(2).Visible = False
End If
If .Fields("空d") <> "" Then
txtTest = txtTest & vbCrLf & "第4空参考答案：" & .Fields("空d")
frmBlank(3).Visible = True
Else
frmBlank(3).Visible = False
End If
End With
'显示试题评阅情况
optYN1(0) = False
optYN1(1) = False
If iRight(iTestNo) = 1 Then
optYN1(0) = True
ElseIf iRight(iTestNo) = 0 Then
optYN1(1) = True
End If
optYN2(0) = False
optYN2(1) = False
If iRight(iTestNo + 1) = 1 Then
optYN2(0) = True
ElseIf iRight(iTestNo + 1) = 0 Then
optYN2(1) = True
End If
optYN3(0) = False
optYN3(1) = False
If iRight(iTestNo + 2) = 1 Then
optYN3(0) = True
ElseIf iRight(iTestNo + 2) = 0 Then
optYN3(1) = True
End If
optYN4(0) = False
optYN4(1) = False
If iRight(iTestNo + 3) = 1 Then
optYN4(0) = True
ElseIf iRight(iTestNo + 3) = 0 Then
optYN4(1) = True
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set objCn = Nothing
Set objJudge = Nothing
Set objTest = Nothing
Set objSelOne = Nothing
Set objProRead = Nothing
Set objProFill = Nothing
End Sub
Private Sub Get_Test_Data()
Dim msg$, i%, Code$, Answer$, iScore%, iTotal%, n%, m%
Dim Code1$, Answer1$, Code2$, Answer2$, Code3$, Answer3$
'统计判断题应得分数
strTest = Split(objTest.Fields("判断题"), Chr(13) & Chr(10))
iScore = objJudge("分数")
For i = 0 To UBound(strTest)
n = InStr(1, strTest(i), "=")
Code = Left(strTest(i), n - 1)
Answer = Mid(strTest(i), n + 1)
With objJudge
.MoveFirst
.Find "编号=" & Code
If (Answer = "TRUE" And .Fields("答案") = True) Or _
(Answer = "FALSE" And .Fields("答案") = False) Then
iTotal = iTotal + iScore
End If
End With
Next i
txtScore(0) = iTotal
'统计选择题应得分数
strTest = Split(objTest.Fields("选择题"), Chr(13) & Chr(10))
iScore = objSelOne("分数")
iTotal = 0
For i = 0 To UBound(strTest)
n = InStr(1, strTest(i), "=")
Code = Left(strTest(i), n - 1)
Answer = Mid(strTest(i), n + 1)
With objSelOne
.MoveFirst
.Find "编号=" & Code
If Answer = .Fields("答案") Then
iTotal = iTotal + iScore
End If
End With
Next i
txtScore(1) = iTotal
'统计程序阅读题应得分数
strTest = Split(objTest.Fields("程序阅读"), Chr(13) & Chr(10))
iScore = objProRead("分数")
iTotal = 0
For i = 0 To UBound(strTest) Step 3
n = InStr(1, strTest(i), "=")
Code = Left(strTest(i), n - 1)
Answer = Mid(strTest(i), n + 1)
n = InStr(1, strTest(i + 1), "=")
Code1 = Left(strTest(i + 1), n - 1)
Answer1 = Mid(strTest(i + 1), n + 1)
n = InStr(1, strTest(i + 2), "=")
Code2 = Left(strTest(i + 2), n - 1)
Answer3 = Mid(strTest(i + 2), n + 1)
With objProRead
.MoveFirst
.Find "编号=" & Code
If Answer = .Fields("答案1") Then iTotal = iTotal + iScore
If .Fields("答案2") <> "" And Answer1 = .Fields("答案2") Then iTotal = iTotal + iScore
If .Fields("答案3") <> "" And Answer2 = .Fields("答案3") Then iTotal = iTotal + iScore
End With
Next i
txtScore(2) = iTotal
'获得程序填空题
strTest = Split(objTest.Fields("程序填空"), Chr(13) & Chr(10))
End Sub
Private Sub optYN1_Click(Index As Integer)
If Index = 0 And iRight(iTestNo) <> 1 Then
iRight(iTestNo) = 1
ElseIf Index = 1 Then
iRight(iTestNo) = 0
End If
Sum_Score
End Sub
Private Sub optYN2_Click(Index As Integer)
If Index = 0 And iRight(iTestNo + 1) <> 1 Then
iRight(iTestNo + 1) = 1
ElseIf Index = 1 Then
iRight(iTestNo + 1) = 0
End If
Sum_Score
End Sub
Private Sub optYN3_Click(Index As Integer)
If Index = 0 And iRight(iTestNo + 2) <> 1 Then
iRight(iTestNo + 2) = 1
ElseIf Index = 1 Then
iRight(iTestNo + 2) = 0
End If
Sum_Score
End Sub
Private Sub optYN4_Click(Index As Integer)
If Index = 0 And iRight(iTestNo + 3) <> 1 Then
iRight(iTestNo + 3) = 1
ElseIf Index = 1 Then
iRight(iTestNo + 3) = 0
End If
Sum_Score
End Sub
Private Sub Sum_Score()
Dim i%, s%
For i = 0 To UBound(iRight)
If iRight(i) = 1 Then s = s + iPFS
Next
txtScore(3) = s
End Sub