www.pudn.com > chap07.rar > frmKS.frm
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Begin VB.Form frmKS
BorderStyle = 1 'Fixed Single
Caption = "考试"
ClientHeight = 7680
ClientLeft = 45
ClientTop = 330
ClientWidth = 9600
Icon = "frmKS.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MouseIcon = "frmKS.frx":030A
Moveable = 0 'False
ScaleHeight = 7680
ScaleWidth = 9600
Begin VB.PictureBox Picture7
BorderStyle = 0 'None
Height = 315
Left = 4170
ScaleHeight = 315
ScaleWidth = 4455
TabIndex = 34
Top = 15
Width = 4455
Begin VB.Label lblLastTime
AutoSize = -1 'True
Caption = "Label4"
ForeColor = &H00FF0000&
Height = 180
Left = 1155
TabIndex = 35
Top = 90
Width = 2595
End
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 330
Left = 0
TabIndex = 7
Top = 7350
Width = 9600
_ExtentX = 16933
_ExtentY = 582
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
EndProperty
MousePointer = 99
End
Begin VB.PictureBox picOptions
BorderStyle = 0 'None
Height = 3780
Index = 3
Left = -20000
ScaleHeight = 3780
ScaleWidth = 5685
TabIndex = 2
TabStop = 0 'False
Top = 480
Width = 5685
Begin VB.Frame fraSample4
Caption = "示例 4"
Height = 1785
Left = 2100
TabIndex = 5
Top = 840
Width = 2055
End
End
Begin VB.PictureBox picOptions
BorderStyle = 0 'None
Height = 3780
Index = 2
Left = -20000
ScaleHeight = 3780
ScaleWidth = 5685
TabIndex = 1
TabStop = 0 'False
Top = 480
Width = 5685
Begin VB.Frame fraSample3
Caption = "示例 3"
Height = 1785
Left = 1545
TabIndex = 4
Top = 675
Width = 2055
End
End
Begin VB.PictureBox picOptions
BorderStyle = 0 'None
Height = 3780
Index = 1
Left = -20000
ScaleHeight = 3780
ScaleWidth = 5685
TabIndex = 0
TabStop = 0 'False
Top = 480
Width = 5685
Begin VB.Frame fraSample2
Caption = "示例 2"
Height = 1785
Left = 645
TabIndex = 3
Top = 300
Width = 2055
End
End
Begin TabDlg.SSTab SSTab1
Height = 7200
Left = 75
TabIndex = 6
TabStop = 0 'False
Top = 60
Width = 9345
_ExtentX = 16484
_ExtentY = 12700
_Version = 393216
Style = 1
Tabs = 2
TabHeight = 520
BackColor = -2147483648
TabCaption(0) = "选择题"
TabPicture(0) = "frmKS.frx":045C
Tab(0).ControlEnabled= -1 'True
Tab(0).Control(0)= "Picture1"
Tab(0).Control(0).Enabled= 0 'False
Tab(0).Control(1)= "Adodc1"
Tab(0).Control(1).Enabled= 0 'False
Tab(0).ControlCount= 2
TabCaption(1) = "判断题"
TabPicture(1) = "frmKS.frx":0478
Tab(1).ControlEnabled= 0 'False
Tab(1).Control(0)= "Adodc2"
Tab(1).Control(0).Enabled= 0 'False
Tab(1).Control(1)= "Picture2"
Tab(1).Control(1).Enabled= 0 'False
Tab(1).ControlCount= 2
Begin MSAdodcLib.Adodc Adodc2
Height = 330
Left = -73425
Top = 4530
Visible = 0 'False
Width = 2550
_ExtentX = 4498
_ExtentY = 582
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = "Adodc2"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin MSAdodcLib.Adodc Adodc1
Height = 360
Left = 1080
Top = 645
Visible = 0 'False
Width = 3255
_ExtentX = 5741
_ExtentY = 635
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
BackColor = &H80000005&
Height = 6525
Left = 150
ScaleHeight = 6465
ScaleWidth = 8970
TabIndex = 8
Top = 435
Width = 9030
Begin VB.Timer Timer1
Interval = 100
Left = 6615
Top = 1905
End
Begin VB.PictureBox Picture4
AutoSize = -1 'True
Height = 975
Left = 5505
ScaleHeight = 915
ScaleWidth = 1230
TabIndex = 24
Top = 210
Visible = 0 'False
Width = 1290
End
Begin VB.PictureBox Picture3
AutoRedraw = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 1740
Left = 6630
ScaleHeight = 1740
ScaleWidth = 1995
TabIndex = 23
Top = 1020
Width = 1995
End
Begin VB.TextBox Text1
BorderStyle = 0 'None
DataField = "F"
DataSource = "Adodc1"
ForeColor = &H000000FF&
Height = 600
Index = 6
Left = 1485
Locked = -1 'True
MultiLine = -1 'True
TabIndex = 22
Text = "frmKS.frx":0494
Top = 4245
Width = 5025
End
Begin VB.TextBox Text1
BorderStyle = 0 'None
DataField = "E"
DataSource = "Adodc1"
ForeColor = &H000000FF&
Height = 600
Index = 5
Left = 1485
Locked = -1 'True
MultiLine = -1 'True
TabIndex = 21
Text = "frmKS.frx":04FE
Top = 3600
Width = 5025
End
Begin VB.TextBox Text1
BorderStyle = 0 'None
DataField = "D"
DataSource = "Adodc1"
ForeColor = &H000000FF&
Height = 600
Index = 4
Left = 1485
Locked = -1 'True
MultiLine = -1 'True
TabIndex = 20
Text = "frmKS.frx":0568
Top = 2955
Width = 5025
End
Begin VB.TextBox Text1
BorderStyle = 0 'None
DataField = "C"
DataSource = "Adodc1"
ForeColor = &H000000FF&
Height = 600
Index = 3
Left = 1485
Locked = -1 'True
MultiLine = -1 'True
TabIndex = 19
Text = "frmKS.frx":05D2
Top = 2310
Width = 5025
End
Begin VB.TextBox Text1
BorderStyle = 0 'None
DataField = "B"
DataSource = "Adodc1"
ForeColor = &H000000FF&
Height = 600
Index = 2
Left = 1485
Locked = -1 'True
MultiLine = -1 'True
TabIndex = 18
Text = "frmKS.frx":0604
Top = 1665
Width = 5025
End
Begin VB.TextBox Text1
BorderStyle = 0 'None
DataField = "A"
DataSource = "adodc1"
ForeColor = &H000000FF&
Height = 600
Index = 1
Left = 1485
Locked = -1 'True
MultiLine = -1 'True
TabIndex = 17
TabStop = 0 'False
Text = "frmKS.frx":0636
Top = 1020
Width = 5025
End
Begin VB.TextBox Text1
BorderStyle = 0 'None
DataField = "tmmc"
DataSource = "Adodc1"
ForeColor = &H00FF0000&
Height = 750
Index = 0
Left = 1485
Locked = -1 'True
MultiLine = -1 'True
TabIndex = 16
TabStop = 0 'False
Text = "frmKS.frx":06A0
Top = 180
Width = 7035
End
Begin VB.Label lblAnswer
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Label2"
DataField = "ksda"
DataSource = "Adodc1"
ForeColor = &H000000FF&
Height = 180
Left = 4455
TabIndex = 26
Top = 5160
Width = 540
End
Begin VB.Label label10
AutoSize = -1 'True
BackColor = &H8000000E&
BackStyle = 0 'Transparent
Caption = "选择答案(按下相应的字母如A、B等即可)："
ForeColor = &H00FF0000&
Height = 180
Left = 1050
TabIndex = 25
Top = 5160
Width = 3420
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
BackColor = &H8000000E&
BackStyle = 0 'Transparent
Caption = "F、"
ForeColor = &H000000FF&
Height = 180
Index = 6
Left = 825
TabIndex = 15
Top = 4245
Width = 540
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
BackColor = &H80000009&
BackStyle = 0 'Transparent
Caption = "E、"
ForeColor = &H000000FF&
Height = 180
Index = 5
Left = 825
TabIndex = 14
Top = 3600
Width = 540
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
BackColor = &H80000009&
BackStyle = 0 'Transparent
Caption = "D、"
ForeColor = &H000000FF&
Height = 180
Index = 4
Left = 825
TabIndex = 13
Top = 2955
Width = 540
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
BackColor = &H80000009&
BackStyle = 0 'Transparent
Caption = "C、"
ForeColor = &H000000FF&
Height = 180
Index = 3
Left = 825
TabIndex = 12
Top = 2310
Width = 540
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
BackColor = &H80000009&
BackStyle = 0 'Transparent
Caption = "B、"
ForeColor = &H000000FF&
Height = 180
Index = 2
Left = 825
TabIndex = 11
Top = 1665
Width = 540
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
BackColor = &H80000009&
BackStyle = 0 'Transparent
Caption = "A、"
ForeColor = &H000000FF&
Height = 180
Index = 1
Left = 825
TabIndex = 10
Top = 1020
Width = 540
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "Label1"
DataField = "stid"
DataSource = "Adodc1"
ForeColor = &H00FF0000&
Height = 180
Index = 0
Left = 660
TabIndex = 9
Top = 180
Width = 540
End
End
Begin VB.PictureBox Picture2
BackColor = &H80000005&
Height = 6465
Left = -74760
ScaleHeight = 6405
ScaleWidth = 8835
TabIndex = 27
Top = 540
Width = 8895
Begin VB.TextBox Text2
BorderStyle = 0 'None
DataField = "tmmc"
DataSource = "Adodc2"
ForeColor = &H00FF0000&
Height = 930
Left = 1485
Locked = -1 'True
MultiLine = -1 'True
TabIndex = 33
Text = "frmKS.frx":072C
Top = 360
Width = 7035
End
Begin VB.PictureBox Picture5
AutoRedraw = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 1740
Left = 1485
ScaleHeight = 1740
ScaleWidth = 1995
TabIndex = 29
Top = 1590
Width = 1995
End
Begin VB.PictureBox Picture6
AutoSize = -1 'True
Height = 975
Left = 5190
ScaleHeight = 915
ScaleWidth = 1230
TabIndex = 28
Top = 2505
Visible = 0 'False
Width = 1290
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Label2"
DataField = "stid"
DataSource = "Adodc2"
ForeColor = &H00FF0000&
Height = 180
Left = 660
TabIndex = 32
Top = 360
Width = 540
End
Begin VB.Label Label3
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "选择答案(按下Y或y表示对，按下N或n表示错)："
ForeColor = &H00FF0000&
Height = 180
Left = 1050
TabIndex = 31
Top = 4320
Width = 3780
End
Begin VB.Label lblYesNo
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Label2"
DataField = "ksda"
DataSource = "Adodc2"
ForeColor = &H000000FF&
Height = 180
Left = 4860
TabIndex = 30
Top = 4320
Width = 540
End
End
End
End
Attribute VB_Name = "frmKS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private mrsXZT As ADODB.Recordset '选择题
Private mrsPDT As ADODB.Recordset '判断题
Private mKssj As Long '考试时间
Private mBeginTime As Date '开始时间
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As Long, ByVal lpDirectory As Long, ByVal nShowCmd As Long) As Long
Private Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long
Private Const SW_SHOWNORMAL = 1
Private mbIsSubmitted As Boolean '是否已经交卷
Private msPerformance As String '成绩
Private msErrorAnswer As String '错误答案
Private Sub Adodc1_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
On Error GoTo ErrHandler
'显隐D、E、F三个选项
If Trim("" & mrsXZT("D")) = "" Then
Label1(4).Visible = False
Else
Label1(4).Visible = True
End If
If Trim("" & mrsXZT("E")) = "" Then
Label1(5).Visible = False
Else
Label1(5).Visible = True
End If
If Trim("" & mrsXZT("F")) = "" Then
Label1(6).Visible = False
Else
Label1(6).Visible = True
End If
'显示图片
If Trim("" & mrsXZT("tp")) <> "" Then
Picture4.Picture = LoadPicture(GetAppPath() & "" & mrsXZT("tp"))
Picture4.AutoSize = True
PaintImage PictureScaleRatio(Picture4, Picture3) * Picture3.ScaleWidth, PictureScaleRatio(Picture4, Picture3) * Picture3.ScaleHeight, Picture4, Picture3, GL_DISPLAY_CENTER
Else
Picture4.Picture = LoadPicture()
Picture3.Picture = LoadPicture()
End If
Exit Sub
ErrHandler:
ErrMessageBox "Adodc1_MoveComplete()", Me.Caption
End Sub
Private Sub Adodc2_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
On Error GoTo ErrHandler
'显示图片
If Trim("" & mrsPDT("tp")) <> "" Then
Picture6.Picture = LoadPicture(GetAppPath() & "" & mrsPDT("tp"))
Picture6.AutoSize = True
PaintImage PictureScaleRatio(Picture6, Picture5) * Picture5.ScaleWidth, PictureScaleRatio(Picture6, Picture5) * Picture5.ScaleHeight, Picture6, Picture5, GL_DISPLAY_CENTER
Else
Picture5.Picture = LoadPicture()
Picture5.Picture = LoadPicture()
End If
Exit Sub
ErrHandler:
ErrMessageBox "Adodc2_MoveComplete()", Me.Caption
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
DealWithKeyBoard KeyCode
End Sub
Private Sub Form_Load()
Dim theArea As RECT
Dim szSQL As String
Dim rs As ADODB.Recordset
On Error GoTo ErrHandler
Screen.MousePointer = 11
'get the workarea
theArea = GetWorkArea()
mbIsSubmitted = False
'设置应用程序的主窗口的大小
Me.Left = theArea.Left * Screen.TwipsPerPixelX
Me.Top = theArea.Top * Screen.TwipsPerPixelX
Me.Width = (theArea.Right - theArea.Left) * Screen.TwipsPerPixelX
Me.Height = (theArea.Bottom - theArea.Top) * Screen.TwipsPerPixelY
'---------------------------------------------------------------
Call SeperateStatusBar(Me.Width)
'------------------------------------------------------
Me.Caption = GS_SYSTEMTITLE & "——考试中..."
'随机生成试卷
Call GenTestPaper
'生成某个考生的试卷
gadoCONN.Execute "DELETE FROM tbKsdj WHERE zh='" & gUserInfo.Zh & "'"
szSQL = "INSERT INTO tbKsdj(zh,stid,tmlb_id,tmlx_id,tmbh,tmmc,tmda,tp,A,B,C,D,E,F) " & _
"SELECT '" & gUserInfo.Zh & "',tbSj.sjbh,tbSj.tmlb_id,tbSj.tmlx_id,tbSj.tmbh," & _
"tbTk.tmmc,tbTk.tmda,tbTk.tp,tbTk.A,tbTk.B,tbTk.C,tbTk.D,tbTk.E,tbTk.F " & _
"FROM tbSj,tbTk " & _
"WHERE tbSj.tmlb_id=tbTk.tmlb_id AND " & _
" tbSj.tmlx_id=tbTk.tmlx_id AND " & _
" tbSj.tmbh=tbTk.tmbh"
gadoCONN.Execute szSQL
'选择题
Set mrsXZT = New ADODB.Recordset
szSQL = "SELECT * FROM tbKsdj WHERE tmlx_id=0 AND zh='" & gUserInfo.Zh & "' ORDER BY stid ASC"
mrsXZT.Open szSQL, gadoCONN, adOpenKeyset, adLockPessimistic, adCmdText
If Not mrsXZT.EOF Then mrsXZT.MoveLast
If Not mrsXZT.BOF Then mrsXZT.MoveFirst
'判断题
Set mrsPDT = New ADODB.Recordset
szSQL = "SELECT * FROM tbKsdj WHERE tmlx_id=1 AND zh='" & gUserInfo.Zh & "' ORDER BY stid ASC"
mrsPDT.Open szSQL, gadoCONN, adOpenKeyset, adLockPessimistic, adCmdText
If Not mrsPDT.EOF Then mrsPDT.MoveLast
If Not mrsPDT.BOF Then mrsPDT.MoveFirst
'显示题目
Set Adodc1.Recordset = mrsXZT
Set Adodc2.Recordset = mrsPDT
SSTab1.TabCaption(0) = "选择题(共" & CStr(Adodc1.Recordset.RecordCount) & "题)"
SSTab1.TabCaption(1) = "判断题(共" & CStr(Adodc2.Recordset.RecordCount) & "题)"
'查看各种题目的数量
Me.Show
If Adodc1.Recordset.RecordCount > 0 Then
Adodc1.Recordset.Move 0
Else
SSTab1.Tab = 1
SSTab1.TabEnabled(0) = False
End If
If Adodc2.Recordset.RecordCount > 0 Then
Adodc2.Recordset.Move 0
Else
SSTab1.Tab = 0
SSTab1.TabEnabled(1) = False
End If
'获取系统设置的考试时间
Set rs = gadoCONN.Execute("SELECT kssj FROM tbParam WHERE id=1")
If Not rs.EOF Then rs.MoveLast
If Not rs.BOF Then rs.MoveFirst
If rs.RecordCount > 0 Then
mKssj = ToLong(rs("kssj"))
Else
mKssj = 45 '缺省时间为45分钟
End If
If Not rs Is Nothing Then
If rs.State = adStateOpen Then
rs.Close
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