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            '用于保存考試記錄數(shù)據(jù)
Dim objJudge As Recordset           '用于保存判斷題題庫數(shù)據(jù)
Dim objSelOne As Recordset          '用于保存選擇題題庫數(shù)據(jù)
Dim objProRead As Recordset         '用于保存程序閱讀題題庫數(shù)據(jù)
Dim objProFill As Recordset         '用于保存程序填空題題庫數(shù)據(jù)
Dim objCn As Connection             '用于建立數(shù)據(jù)庫連接
Dim objTeacher As Recordset         '用于保存閱卷教師數(shù)據(jù)
Dim strTest                         '用于表存學(xué)生答題信息
Dim iTestNo%                        '用于保存當(dāng)前題號
Dim iRight%()                       '用于保存程序填空題的評閱結(jié)果
Dim iPFS%                           '用于保存程序填空題的小題分?jǐn)?shù)
Dim StuCode$                        '用于保存當(dāng)前試卷學(xué)生的考號
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
    '保存當(dāng)前學(xué)生試卷成績
    strSQL = "update 學(xué)生信息 set 成績=" & Str(i) _
            & " where 考號='" & StuCode & "'"
    objCn.Execute strSQL
    '保存閱卷記錄
    strSQL = "Insert Into 閱卷記錄 (教師,考號) Values (" _
             & Str(objTeacher.Fields("編號")) & ",'" & StuCode & "')"
    objCn.Execute strSQL
    MsgBox "成績提交成功！", vbInformation, "教師閱卷"
    '更新教師閱卷信息
    lblTotal = "剩余份數(shù)：" & Str(Val(Mid(lblTotal, 6)) - 1)
    lblChecked = "已閱份數(shù)：" & Str(Val(Mid(lblChecked, 6)) + 1)
    txtNum = Str(Val(txtNum) + 1)
    '獲得下一份試卷
    With objTest
         .Close
         Set .ActiveConnection = objCn                   '建立數(shù)據(jù)庫連接
        .Open "SELECT TOP 1 考試記錄.* FROM 考試記錄,學(xué)生信息 " _
                & " WHERE 考試記錄.考號=學(xué)生信息.考號 and 成績 is null"
        Set .ActiveConnection = Nothing                  '斷開數(shù)據(jù)庫連接
        If .RecordCount = 0 Then
            MsgBox "試卷已經(jīng)評閱完畢！"
            picNavigation.Enabled = False
            cmdSubmit.Enabled = False
            Exit Sub
        End If
        StuCode = .Fields("考號")
    End With
    Get_Test_Data
    iTestNo = 0
    ReDim iRight(UBound(strTest))
    '設(shè)置默認值
    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                                 '建立數(shù)據(jù)庫聯(lián)接
        .Provider = "SQLOLEDB"
        .ConnectionString = "User ID=sa;PWD=123;Data Source=(local);Initial Catalog=自測考試"
        .Open
    End With
    '訪問數(shù)據(jù)庫獲得判斷題數(shù)據(jù)
    Set objJudge = New Recordset                '實例化對象
    With objJudge
        Set .ActiveConnection = objCn           '建立數(shù)據(jù)庫連接
        .CursorLocation = adUseClient           '指定使用客戶端游標(biāo)
        .Open "SELECT * FROM 判斷題"            '獲取判斷題數(shù)據(jù)
        Set .ActiveConnection = Nothing         '斷開數(shù)據(jù)庫連接
    End With
    '訪問數(shù)據(jù)庫獲得單項選擇題數(shù)據(jù)
    Set objSelOne = New Recordset                '實例化對象
    With objSelOne
        Set .ActiveConnection = objCn           '建立數(shù)據(jù)庫連接
        .CursorLocation = adUseClient           '指定使用客戶端游標(biāo)
        .Open "SELECT * FROM 選擇題"            '獲取選擇題數(shù)據(jù)
        Set .ActiveConnection = Nothing         '斷開數(shù)據(jù)庫連接
    End With
    '訪問數(shù)據(jù)庫獲得程序閱讀題數(shù)據(jù)
    Set objProRead = New Recordset                '實例化對象
    With objProRead
        Set .ActiveConnection = objCn           '建立數(shù)據(jù)庫連接
        .CursorLocation = adUseClient           '指定使用客戶端游標(biāo)
        .Open "SELECT * FROM 程序閱讀"          '獲取程序閱讀題數(shù)據(jù)
        Set .ActiveConnection = Nothing         '斷開數(shù)據(jù)庫連接
    End With
    '訪問數(shù)據(jù)庫獲得程序填空題數(shù)據(jù)
     Set objProFill = New Recordset                '實例化對象
    With objProFill
         Set .ActiveConnection = objCn           '建立數(shù)據(jù)庫連接
        .CursorLocation = adUseClient           '指定使用客戶端游標(biāo)
        .Open "SELECT * FROM 程序填空"          '獲取程序填空題數(shù)據(jù)
        Set .ActiveConnection = Nothing         '斷開數(shù)據(jù)庫連接
        iPFS = .Fields("分?jǐn)?shù)")
    End With
    '訪問數(shù)據(jù)庫獲得第一份批改試卷數(shù)據(jù)
    Set objTest = New Recordset                '實例化對象
    With objTest
        Set .ActiveConnection = objCn                   '建立數(shù)據(jù)庫連接
        .CursorLocation = adUseClient                   '指定使用客戶端游標(biāo)
        .Open "SELECT TOP 1 考試記錄.* FROM 考試記錄,學(xué)生信息 " _
                & " WHERE 考試記錄.考號=學(xué)生信息.考號 and 成績 is null"
        Set .ActiveConnection = Nothing                  '斷開數(shù)據(jù)庫連接
        If .RecordCount = 0 Then
            MsgBox "試卷已經(jīng)評閱完畢！"
            Frame2.Enabled = False
            picNavigation.Enabled = False
            cmdSubmit.Enabled = False
            Exit Sub
        End If
        StuCode = .Fields("考號")
    End With
    '訪問數(shù)據(jù)庫獲得閱卷教師信息
    Set objTeacher = New Recordset                '實例化對象
    With objTeacher
        Set .ActiveConnection = objCn           '建立數(shù)據(jù)庫連接
        .CursorLocation = adUseClient           '指定使用客戶端游標(biāo)
        .Open "SELECT * FROM 閱卷教師 where 姓名='" & CurrentUserName & "'"          '獲得閱卷教師信息
        Set .ActiveConnection = Nothing         '斷開數(shù)據(jù)庫連接
        If .RecordCount = 0 Then
            MsgBox "請以閱卷教師身份登錄系統(tǒng)，否則不能正常使用閱卷功能！", , Me.Caption
            Frame2.Enabled = False
            picNavigation.Enabled = False
            cmdSubmit.Enabled = False
            Exit Sub
        End If
        frmTeacher.Caption = CurrentUserName & "閱卷信息"
        lblTotal = "剩余份數(shù)：" & .Fields("數(shù)量")
        lblChecked = "已閱份數(shù)：0"
        txtNum = "1"
    End With
    '顯示試卷程序填空題以及客觀分?jǐn)?shù)
    Get_Test_Data
    iTestNo = 0
    ReDim iRight(UBound(strTest))
    '設(shè)置默認值
    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)
    '該變當(dāng)前程序填空題
    Select Case Index
        Case 0                  '使第一題成為當(dāng)前題
            If iTestNo <> 0 Then iTestNo = 0
        Case 1                  '使上一題成為當(dāng)前題
            iTestNo = iTestNo - 4
            If iTestNo < 0 Then iTestNo = 0
        Case 2                  '使下一個記錄成為當(dāng)前題
            iTestNo = iTestNo + 4
            If iTestNo > UBound(strTest) Then iTestNo = UBound(strTest) - 3
        Case 3                  '使最后一題成為當(dāng)前題
            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$
    '統(tǒng)計判斷題應(yīng)得分?jǐn)?shù)
    strTest = Split(objTest.Fields("判斷題"), Chr(13) & Chr(10))
    iScore = objJudge("分?jǐn)?shù)")
    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
    '統(tǒng)計選擇題應(yīng)得分?jǐn)?shù)
    strTest = Split(objTest.Fields("選擇題"), Chr(13) & Chr(10))
    iScore = objSelOne("分?jǐn)?shù)")
    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
    '統(tǒng)計程序閱讀題應(yīng)得分?jǐn)?shù)
    strTest = Split(objTest.Fields("程序閱讀"), Chr(13) & Chr(10))
    iScore = objProRead("分?jǐn)?shù)")
    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