frmcheck.frm

考试系统:通过学生,教师,管理员三个身份可以登陆系统,教师和管理员有修改试卷的权限.

VERSION 5.00
Begin VB.Form frmCheck 
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   7200
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   7212
   LinkTopic       =   "Form1"
   ScaleHeight     =   7200
   ScaleWidth      =   7212
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton CmdCancel 
      Caption         =   "取消"
      Height          =   375
      Left            =   6120
      TabIndex        =   12
      Top             =   6720
      Width           =   855
   End
   Begin VB.CommandButton CmdOK 
      Caption         =   "确定"
      Height          =   375
      Left            =   5040
      TabIndex        =   11
      Top             =   6720
      Width           =   855
   End
   Begin VB.TextBox txtCheck 
      Appearance      =   0  'Flat
      BeginProperty Font 
         Name            =   "方正舒体"
         Size            =   14.4
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1095
      Left            =   120
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   10
      Top             =   5280
      Width           =   6975
   End
   Begin VB.TextBox txtAnswer 
      Appearance      =   0  'Flat
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   14.4
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1335
      Left            =   120
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   6
      Top             =   3360
      Width           =   6975
   End
   Begin VB.CommandButton CmdCheck 
      Caption         =   "评分"
      Height          =   375
      Left            =   3720
      TabIndex        =   5
      Top             =   6720
      Width           =   1095
   End
   Begin VB.CommandButton CmdLast 
      Caption         =   ">|"
      Height          =   375
      Left            =   2280
      TabIndex        =   4
      Top             =   6720
      Width           =   735
   End
   Begin VB.CommandButton CmdNext 
      Caption         =   ">"
      Height          =   375
      Left            =   1560
      TabIndex        =   3
      Top             =   6720
      Width           =   735
   End
   Begin VB.CommandButton CmdPrev 
      Caption         =   "<"
      Height          =   375
      Left            =   840
      TabIndex        =   2
      Top             =   6720
      Width           =   735
   End
   Begin VB.CommandButton CmdFirst 
      Caption         =   "|<"
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   6720
      Width           =   735
   End
   Begin VB.TextBox txtQuestion 
      Appearance      =   0  'Flat
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   14.4
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2175
      Left            =   120
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Top             =   600
      Width           =   6975
   End
   Begin VB.Label lblCheck 
      Caption         =   "考生答案"
      BeginProperty Font 
         Name            =   "华文行楷"
         Size            =   21.6
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   375
      Left            =   120
      TabIndex        =   9
      Top             =   4800
      Width           =   2775
   End
   Begin VB.Label lblA 
      Caption         =   "参考答案"
      BeginProperty Font 
         Name            =   "华文行楷"
         Size            =   21.6
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   375
      Left            =   120
      TabIndex        =   8
      Top             =   2880
      Width           =   2775
   End
   Begin VB.Label lblQ 
      Caption         =   "题目"
      BeginProperty Font 
         Name            =   "华文行楷"
         Size            =   21.6
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   375
      Left            =   120
      TabIndex        =   7
      Top             =   120
      Width           =   2775
   End
End
Attribute VB_Name = "frmCheck"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim QSerial As Long
Dim iCount As Long
Private Sub View()
    QSerial = QPaper.GetQSerial(iCount)
    txtQuestion.Text = QPaper.GetQuestion(QSerial)
    txtAnswer.Text = QPaper.GetQAnswer(QSerial)
    txtCheck.Text = QPaper.GetUserAnswer(QSerial)
End Sub
Private Sub CmdCancel_Click()
    Unload Me
End Sub

Private Sub CmdCheck_Click()
    Dim QType As QuestionType
    QType = QPaper.GetType(QSerial)
    If QType <> Blacks And QType <> EssayQuestion Then
        Exit Sub
    End If
    Dim S As Single
    Dim str As String
    DataEnv.rsQstPaper.Open
    DataEnv.rsQstPaper.Filter = "PaperSerial = " & CStr(QSerial)
    S = DataEnv.rsQstPaper.Fields("Score")
    str = InputBox("输入分数值(应得分数 " & CStr(S) & ")", "评分", S)
    If IsNumeric(str) Then
        S = CSng(str)
        DataEnv.rsQstPaper.Fields("Commence") = S
        DataEnv.rsQstPaper.Update
        DataEnv.rsQstPaper.Filter = ""
    End If
    DataEnv.rsQstPaper.Close
End Sub

Private Sub CmdFirst_Click()
    iCount = 1
    View
End Sub

Private Sub CmdLast_Click()
    iCount = QPaper.QuestionNum
    View
End Sub

Private Sub CmdNext_Click()
    If iCount < QPaper.QuestionNum Then
        iCount = iCount + 1
        View
    End If
End Sub

Private Sub CmdOk_Click()
    QPaper.Checked = True
    Unload Me
End Sub

Private Sub CmdPrev_Click()
    If iCount > 1 Then
        iCount = iCount - 1
        View
    End If
End Sub

Private Sub Form_Load()
    Dim Q As Long
    Q = QPaper.QuestionNum
    Dim t As QuestionType
    For iCount = 1 To Q
        QSerial = QPaper.GetQSerial(iCount)
        t = QPaper.GetType(QSerial)
        If t = RightOrWrong Or t = singlesel Or t = MultiSel Then
            QPaper.Check (QSerial)
            QPaper.Checked = True
        End If
    Next
    iCount = 1
    View
End Sub