frmks.frm

Visual basic 数据库编程技术与实例源码 源码

        End If
        Set rs = Nothing
    End If
    
    '记录开始时间
    mBeginTime = Now
    '----------------------------------
    Screen.MousePointer = 0
    Exit Sub
ErrHandler:
    Screen.MousePointer = 0
    ErrMessageBox Me.Name & ":Form_Load()", Me.Caption
End Sub
'设置状态栏
Private Sub SeperateStatusBar(ByVal totalwd As Double)
    Dim wd As Double
    Dim i As Long
    Dim ct As Long
    Dim panelX As Panel
    
    ct = 8
    wd = totalwd / 16
    
    For i = 1 To ct
        Set panelX = StatusBar1.Panels.Add()
        panelX.Alignment = sbrCenter
        panelX.Width = 2 * wd
    Next
    
    
    StatusBar1.Panels(1) = "F1-帮助"
    StatusBar1.Panels(2) = "F2-选择题"
    StatusBar1.Panels(3) = "F3-判断题"
    StatusBar1.Panels(4) = "F4-成绩"
    StatusBar1.Panels(5) = "F5-错误答案"
    StatusBar1.Panels(6) = "PageUp-上一页"
    StatusBar1.Panels(7) = "PageDown-下一页"
    StatusBar1.Panels(8) = "Esc-交卷"
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim lReturn As Long
    
    '如果已经提交过答案了，则不提示
    If mbIsSubmitted = True Then
        Exit Sub
    End If
    '提示交卷
    Select Case UnloadMode
        Case vbFormControlMenu
            lReturn = MsgBox("你还没有交卷,请作如下选择：" & vbCrLf & _
                           "  是——马上交卷" & vbCrLf & _
                           "  否——不交卷退出" & vbCrLf & _
                           "取消——返回继续考试", vbYesNoCancel + vbQuestion, Me.Caption)
            Select Case lReturn
                Case vbYes
                    Cancel = 1
                    SendKeys "{Esc}"
                Case vbNo
                Case vbCancel
                    Cancel = 1
            End Select
        Case Else
    End Select
        
End Sub
Private Sub Form_Resize()
    Dim i As Long
    '
    SSTab1.Left = 45
    SSTab1.Top = 45
    SSTab1.Width = Me.ScaleWidth - SSTab1.Left * 2
    SSTab1.Height = Me.ScaleHeight - StatusBar1.Height - 2 * SSTab1.Top
    
    '-----------------------------------------------------------------
    Picture1.Left = 45
    Picture1.Top = 45 + SSTab1.TabHeight
    Picture1.Width = SSTab1.Width - 90
    Picture1.Height = SSTab1.Height - SSTab1.TabHeight - 90
    
    '
    Picture2.Left = Picture1.Left
    Picture2.Top = Picture1.Top
    Picture2.Width = Picture1.Width
    Picture2.Height = Picture1.Height
    
    '
'    Text1(0).Width = Picture1.Width - Text1(0).Left - 100
'    Picture3.Left = Text1(0).Left + Text1(0).Width - Picture3.Width
'
'    For i = 1 To 6
'        Text1(i).Width = Picture3.Left - Text1(i).Left - 100
'    Next i
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim i As Long
    
            
    '关闭选择题
    If Not mrsXZT Is Nothing Then
        If mrsXZT.State = adStateOpen Then
            mrsXZT.Close
        End If
        Set mrsXZT = Nothing
    End If
    
    '关闭判断题
    If Not mrsPDT Is Nothing Then
        If mrsPDT.State = adStateOpen Then
            mrsPDT.Close
        End If
        Set mrsPDT = Nothing
    End If
    
    '断开数据库连接
    If Not gadoCONN Is Nothing Then
        If gadoCONN.State = adStateOpen Then
            gadoCONN.Close
        End If
        Set gadoCONN = Nothing
    End If
    
    'close all sub forms
    For i = Forms.Count - 1 To 1 Step -1
        Unload Forms(i)
    Next
    
    '----------------------------------------
    End
End Sub
'处理键盘消息
Private Sub DealWithKeyBoard(ByVal KeyCode As Integer)
    Static cs As Integer
    Dim xztDF As Long '选择题得分
    Dim pdtDF As Long '判断题得分
    Dim i As Long
    Dim ct As Long
    Dim bJJ As Boolean  '是否交卷
    
    On Error Resume Next
    '控制键盘按键次数
    If TypeOf Screen.ActiveControl Is SSTab Then
        If cs = 0 Then
            cs = 1
        Else
            If cs >= 1 Then
                cs = 0
                Exit Sub
            End If
        End If
    End If
    '----------------------------------------------
    Select Case KeyCode
        Case vbKeyA, vbKeyB, vbKeyC
            If SSTab1.Tab = 0 Then
                lblAnswer.Caption = CStr(Chr(KeyCode))
            End If
        Case vbKeyD
            If SSTab1.Tab = 0 Then
                If Trim("" & mrsXZT("D")) <> "" Then '有D选项
                    lblAnswer.Caption = CStr(Chr(KeyCode))
                End If
            End If
        Case vbKeyE
            If SSTab1.Tab = 0 Then
                If Trim("" & mrsXZT("E")) <> "" Then '有E选项
                    lblAnswer.Caption = CStr(Chr(KeyCode))
                End If
            End If
        Case vbKeyF
            If SSTab1.Tab = 0 Then
                If Trim("" & mrsXZT("F")) <> "" Then '有F选项
                    lblAnswer.Caption = CStr(Chr(KeyCode))
                End If
            End If
        Case vbKeyEscape
            '是否已经提交过试卷
            If mbIsSubmitted = True Then
                MsgBox "你已经提交过试卷，你的成绩如下：" & vbCrLf & msPerformance, vbOKOnly + vbInformation, "提示"
                Exit Sub
            End If
            '评阅试卷
            bJJ = False
            
            If CStr(lblLastTime.Tag) <> "" Then
                bJJ = True
            End If
            If bJJ = False Then
                If MsgBox("真的要交卷吗？", vbYesNo + vbQuestion, Me.Caption) = vbYes Then
                    bJJ = True
                End If
            End If
            If bJJ = True Then
                '进行交卷，计算并报告成绩
                Screen.MousePointer = 11
                
                msErrorAnswer = ""
                '计算选择题得分
                If Not Adodc1.Recordset.BOF Then Adodc1.Recordset.MoveFirst
                ct = Adodc1.Recordset.RecordCount
                For i = 1 To ct
                    If Trim("" & mrsXZT("tmda")) = Trim("" & mrsXZT("ksda")) Then
                        xztDF = xztDF + 1
                        mrsXZT("CJ") = 1
                    Else
                        mrsXZT("CJ") = 0
                        '错误的提示
                        If msErrorAnswer = "" Then
                            msErrorAnswer = "选择题答错题号及正确答案："
                        End If
                        
                        msErrorAnswer = msErrorAnswer & vbCrLf & CStr(mrsXZT("stid")) & ":" & CStr(mrsXZT("tmda"))
                    End If
                    
                    If i < ct Then
                        mrsXZT.MoveNext
                    End If
                Next
                If ct > 0 Then
                    mrsXZT.Update
                End If
                '计算判断题得分
                If msErrorAnswer = "" Then
                    msErrorAnswer = "判断题答错题号及正确答案："
                Else
                    msErrorAnswer = msErrorAnswer & vbCrLf & "判断题答错题号及正确答案："
                End If
                
                If Not Adodc2.Recordset.BOF Then Adodc2.Recordset.MoveFirst
                ct = Adodc2.Recordset.RecordCount
                For i = 1 To ct
                    If Trim("" & mrsPDT("tmda")) = Trim("" & mrsPDT("ksda")) Then
                        pdtDF = pdtDF + 1
                        mrsPDT("CJ") = 1
                    Else
                        mrsPDT("CJ") = 0
                        
                        msErrorAnswer = msErrorAnswer & vbCrLf & CStr(mrsPDT("stid")) & ":" & CStr(mrsPDT("tmda"))
                    End If
                    
                    If i < ct Then
                        mrsPDT.MoveNext
                    End If
                Next
                If ct > 0 Then
                    mrsPDT.Update
                End If
                
                Screen.MousePointer = 0
                msPerformance = "选择题得分：" & CStr(xztDF) & vbCrLf & "判断题得分：" & CStr(pdtDF) & vbCrLf & "最    后得分：" & CStr(xztDF + pdtDF)
                '
                MsgBox "成绩统计如下：" & vbCrLf & msPerformance, vbOKOnly + vbInformation, GS_SYSTEMTITLE & "——考试结束"
                '----------------------------------
                mbIsSubmitted = True
                If msErrorAnswer <> "" Then
                    MsgBox msErrorAnswer, vbOKOnly + vbInformation, "提示"
                End If
            End If
        Case vbKeyY
            If SSTab1.Tab = 1 Then '当前为判断题
                lblYesNo.Caption = "对"
            End If
        Case vbKeyN
            If SSTab1.Tab = 1 Then '当前为判断题
                lblYesNo.Caption = "错"
            End If
        Case vbKeyPageDown
            If SSTab1.Tab = 0 Then '选择题
                If Adodc1.Recordset.AbsolutePosition > 0 Then
                    If Adodc1.Recordset.AbsolutePosition < Adodc1.Recordset.RecordCount Then
                        Adodc1.Recordset.MoveNext
                    Else
                        Adodc1.Recordset.Move 0
                    End If
                End If
            Else '判断题
                If Adodc2.Recordset.AbsolutePosition > 0 Then
                    If Adodc2.Recordset.AbsolutePosition < Adodc2.Recordset.RecordCount Then
                        Adodc2.Recordset.MoveNext
                    Else
                        Adodc2.Recordset.Move 0
                    End If
                End If
            End If
        Case vbKeyPageUp
            If SSTab1.Tab = 0 Then '选择题
                If Adodc1.Recordset.AbsolutePosition > 0 Then
                    If Adodc1.Recordset.AbsolutePosition > 1 Then
                        Adodc1.Recordset.MovePrevious
                    Else
                        Adodc1.Recordset.Move 0
                    End If
                End If
            Else '判断题
                If Adodc2.Recordset.AbsolutePosition > 0 Then
                    If Adodc2.Recordset.AbsolutePosition > 1 Then
                        Adodc2.Recordset.MovePrevious
                    Else
                        Adodc2.Recordset.Move 0
                    End If
                End If
            End If
        Case vbKeyF1 '帮助
            'ShellExecute Me.hwnd, "Open", "hh " & GetAppPath() & "jttest.chm::/考试管理.htm", 0, 0, SW_SHOWNORMAL
            'HtmlHelp Me.hwnd, GetAppPath() & "jttest.chm::/考试管理.htm", HH_DISPLAY_INDEX, 0
            WinExec "hh " & GetAppPath() & "jttest.chm::/考试管理.htm", SW_SHOWNORMAL
        Case vbKeyF2 '选择题
            If Adodc1.Recordset.RecordCount > 0 Then
                SSTab1.Tab = 0
            Else
                MsgBox "试卷中没有选择题！", vbOKOnly + vbInformation, Me.Caption
                SSTab1.Tab = 1
            End If
        Case vbKeyF3 '判断题
            If Adodc2.Recordset.RecordCount > 0 Then
                SSTab1.Tab = 1
            Else
                MsgBox "试卷中没有判断题！", vbOKOnly + vbInformation, Me.Caption
                SSTab1.Tab = 0
            End If
        Case vbKeyF4 '成绩
            If mbIsSubmitted = False Then
                MsgBox "你还没有交卷，请按'Esc'键进行交卷", vbOKOnly + vbInformation, "提示"
            Else
                MsgBox "你的成绩如下：" & vbCrLf & msPerformance, vbOKOnly + vbInformation, "提示"
            End If
        Case vbKeyF5 '错误答案
            If mbIsSubmitted = False Then
                 MsgBox "你还没有交卷，请按'Esc'键进行交卷", vbOKOnly + vbInformation, "提示"
            Else
                If msErrorAnswer = "" Then
                    MsgBox "祝贺你得了满分，因此没有答错的题目！", vbOKOnly + vbInformation, "提示"
                Else
                    MsgBox msErrorAnswer, vbOKOnly + vbInformation, "提示"
                End If
            End If
        Case Else
    End Select
End Sub
Private Sub StatusBar1_PanelClick(ByVal Panel As MSComctlLib.Panel)
    On Error Resume Next
    
    Select Case Panel.Index
        Case 1
            SendKeys "{F1}"
        Case 2
            SendKeys "{F2}"
        Case 3
            SendKeys "{F3}"
        Case 4
            SendKeys "{F4}"
        Case 5
            SendKeys "{F5}"
        Case 6
            SendKeys "{PGUP}"
        Case 7
            SendKeys "{PGDN}"
        Case 8
            SendKeys "{ESC}"
    End Select
End Sub

Private Sub Timer1_Timer()
    Dim curTime As Date
    Dim n As Long '已经过了多少分钟
    
    On Error Resume Next
    curTime = Now
    n = Abs(DateDiff("n", curTime, mBeginTime))
    '显示还有多少时间
    If n < mKssj Then
        lblLastTime.Caption = "离考试结束还有 " & CStr(mKssj - n) & " 分钟..."
    Else
        lblLastTime.Caption = "离考试结束还有 0 分钟..."
        MsgBox "你的考试时间已到，将马上交卷！", vbOKOnly + vbInformation, "警告"
        lblLastTime.Tag = "-1"
        SendKeys "{ESC}"
    End If
End Sub