frmtoscoring.frm

自测考试系统

         Height          =   180
         Left            =   225
         TabIndex        =   19
         Top             =   720
         Width           =   900
      End
      Begin VB.Label Label7 
         AutoSize        =   -1  'True
         Caption         =   "当前试卷"
         Height          =   180
         Left            =   1800
         TabIndex        =   18
         Top             =   360
         Width           =   720
      End
   End
   Begin VB.Frame Frame3 
      Caption         =   "问答题学生答题"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   4875
      Left            =   5280
      TabIndex        =   12
      Top             =   360
      Width           =   3060
      Begin VB.TextBox txtscoreans 
         Height          =   270
         Left            =   1080
         TabIndex        =   47
         Top             =   4350
         Width           =   975
      End
      Begin VB.TextBox txtStuAnswer1 
         Height          =   3600
         Left            =   120
         Locked          =   -1  'True
         TabIndex        =   13
         Top             =   600
         Width           =   2760
      End
      Begin VB.Label Label8 
         Caption         =   "评分"
         Height          =   255
         Left            =   600
         TabIndex        =   46
         Top             =   4400
         Width           =   375
      End
      Begin VB.Label Label6 
         Caption         =   "学生答案"
         Height          =   255
         Index           =   7
         Left            =   120
         TabIndex        =   14
         Top             =   360
         Width           =   855
      End
   End
   Begin VB.Frame Frame4 
      Caption         =   "试卷得分"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   4875
      Left            =   8520
      TabIndex        =   0
      Top             =   360
      Width           =   2160
      Begin VB.TextBox txtscore 
         Height          =   300
         Index           =   4
         Left            =   255
         Locked          =   -1  'True
         TabIndex        =   10
         Top             =   3510
         Width           =   1650
      End
      Begin VB.TextBox txtscore 
         Height          =   300
         Index           =   0
         Left            =   240
         Locked          =   -1  'True
         TabIndex        =   5
         Top             =   660
         Width           =   1650
      End
      Begin VB.TextBox txtscore 
         Height          =   300
         Index           =   1
         Left            =   240
         Locked          =   -1  'True
         TabIndex        =   4
         Top             =   1380
         Width           =   1650
      End
      Begin VB.TextBox txtscore 
         Height          =   300
         Index           =   2
         Left            =   240
         Locked          =   -1  'True
         TabIndex        =   3
         Top             =   2100
         Width           =   1650
      End
      Begin VB.TextBox txtscore 
         Height          =   300
         Index           =   3
         Left            =   255
         Locked          =   -1  'True
         TabIndex        =   2
         Top             =   2820
         Width           =   1650
      End
      Begin VB.CommandButton cmdSubmit 
         Caption         =   "提交"
         Height          =   300
         Left            =   645
         TabIndex        =   1
         Top             =   4200
         Width           =   870
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "五、问答题"
         Height          =   180
         Left            =   240
         TabIndex        =   11
         Top             =   3240
         Width           =   900
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "一、判断题"
         Height          =   180
         Left            =   240
         TabIndex        =   9
         Top             =   435
         Width           =   900
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "二、单选题"
         Height          =   180
         Left            =   240
         TabIndex        =   8
         Top             =   1140
         Width           =   900
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         Caption         =   "三、多选题"
         Height          =   180
         Left            =   240
         TabIndex        =   7
         Top             =   1845
         Width           =   900
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         Caption         =   "四、填空题"
         Height          =   180
         Left            =   240
         TabIndex        =   6
         Top             =   2550
         Width           =   900
      End
   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 objselmany As Recordset         '用于保存多项选择题题库数据
Dim objfill As Recordset            '用于保存程序填空题题库数据
Dim objanswer As Recordset          '用于保存问答题题库数据
Dim objCn As Connection             '用于建立数据库连接
Dim objTeacher As Recordset         '用于保存阅卷教师数据
Dim strTest                         '用于保存学生填空题答题信息
Dim strTest1                         '用于保存学生问答题答题信息
Dim iTestNo%                        '用于保存当前题号
Dim iRight%()                       '用于保存填空题的评阅结果
Dim iffs%                           '用于保存填空题的小题分数
Dim StuCode$                        '用于保存当前试卷学生的考号
Dim oldfs%()

Private Sub Cmbtype_Click()
  '显示对应题型的第小题
  Dim n, code(3), answer(3), code1, answer1
    Select Case cmbtype.ListIndex
        Case 0
            Frame2.Visible = True
            Frame3.Visible = False
            Frame1.Caption = "填空题及参考答案"
            '显示填空题第一小题
            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 objfill
                 .MoveFirst
                 .Find "编号=" & code(0)
                 txttest = "【" & Trim(Str(iTestNo / 4 + 1)) & "】" & vbCrLf _
                        & .Fields("题干") & vbCrLf & "第1空参考答案：" & .Fields("空1")
            If .Fields("空2") <> "" Then
                  txttest = txttest & vbCrLf & "第2空参考答案：" & .Fields("空2")
                  frmBlank(1).Visible = True
            Else
                  frmBlank(1).Visible = False
            End If
            If .Fields("空3") <> "" Then
                  txttest = txttest & vbCrLf & "第3空参考答案：" & .Fields("空3")
                  frmBlank(2).Visible = True
            Else
                  frmBlank(2).Visible = False
            End If
            If .Fields("空4") <> "" Then
                 txttest = txttest & vbCrLf & "第4空参考答案：" & .Fields("空4")
                 frmBlank(3).Visible = True
           Else
                frmBlank(3).Visible = False
           End If
           End With
        Case 1
             iTestNo = 0
             Frame2.Visible = False
             Frame3.Visible = True
             Frame1.Caption = "问答题及参考答案"
             n = InStr(strTest1(iTestNo), "=")
             code1 = Left(strTest1(iTestNo), n - 1)
             answer1 = Mid(strTest1(iTestNo), n + 1)
             txtStuAnswer1 = answer1
             '显示问答题及参考答案
             With objanswer
                  .MoveFirst
                  .Find "编号=" & code1
                  txttest = "【" & Trim(Str(iTestNo + 1)) & "】" & vbCrLf _
                          & .Fields("题干") & vbCrLf & "参考答案：" & .Fields("答案")
            End With
        End Select
   
End Sub

Private Sub cmdexit_Click()
    Unload Me
End Sub

Private Sub cmdmove_Click(Index As Integer)
 Dim n, code$(3), answer$(3), code1, answer1
 Static s%
 If cmbtype.ListIndex = 0 Then
    Frame2.Visible = True
    Frame3.Visible = False
    Frame1.Caption = "填空题及参考答案"
    '该变当前程序填空题
    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 objfill
        .MoveFirst
        .Find "编号=" & code(0)
        txttest = "【" & Trim(Str(iTestNo / 4 + 1)) & "】" & vbCrLf _
                & .Fields("题干") & vbCrLf & "第1空参考答案：" & .Fields("空1")
        If .Fields("空2") <> "" Then
            txttest = txttest & vbCrLf & "第2空参考答案：" & .Fields("空2")
            frmBlank(1).Visible = True
        Else
            frmBlank(1).Visible = False
        End If
        If .Fields("空3") <> "" Then
            txttest = txttest & vbCrLf & "第3空参考答案：" & .Fields("空3")
            frmBlank(2).Visible = True
        Else
            frmBlank(2).Visible = False
        End If
        If .Fields("空4") <> "" Then
            txttest = txttest & vbCrLf & "第4空参考答案：" & .Fields("空4")
            frmBlank(3).Visible = True
        Else