frmselecttest.frm

自测考试系统

      Top             =   2640
      Width           =   495
   End
   Begin VB.Label Label21 
      BackStyle       =   0  'Transparent
      Caption         =   "4、填空题"
      Height          =   255
      Left            =   360
      TabIndex        =   31
      Top             =   2640
      Width           =   855
   End
   Begin VB.Label Label20 
      BackStyle       =   0  'Transparent
      Caption         =   "分"
      Height          =   255
      Left            =   6120
      TabIndex        =   28
      Top             =   2175
      Width           =   375
   End
   Begin VB.Label Label19 
      BackStyle       =   0  'Transparent
      Caption         =   "共"
      Height          =   255
      Left            =   5040
      TabIndex        =   26
      Top             =   2175
      Width           =   375
   End
   Begin VB.Label Label18 
      BackStyle       =   0  'Transparent
      Caption         =   "分"
      Height          =   255
      Left            =   4200
      TabIndex        =   25
      Top             =   2175
      Width           =   375
   End
   Begin VB.Label Label17 
      BackStyle       =   0  'Transparent
      Caption         =   "每题"
      Height          =   255
      Left            =   2880
      TabIndex        =   23
      Top             =   2175
      Width           =   495
   End
   Begin VB.Label Label16 
      BackStyle       =   0  'Transparent
      Caption         =   "小题"
      Height          =   255
      Left            =   1920
      TabIndex        =   22
      Top             =   2175
      Width           =   495
   End
   Begin VB.Label Label15 
      BackStyle       =   0  'Transparent
      Caption         =   "3、多选题"
      Height          =   255
      Left            =   360
      TabIndex        =   20
      Top             =   2175
      Width           =   855
   End
   Begin VB.Label Label14 
      BackStyle       =   0  'Transparent
      Caption         =   "分"
      Height          =   255
      Left            =   6120
      TabIndex        =   19
      Top             =   1665
      Width           =   375
   End
   Begin VB.Label Label13 
      BackStyle       =   0  'Transparent
      Caption         =   "共"
      Height          =   255
      Left            =   5040
      TabIndex        =   17
      Top             =   1665
      Width           =   375
   End
   Begin VB.Label Label12 
      BackStyle       =   0  'Transparent
      Caption         =   "分"
      Height          =   255
      Left            =   4200
      TabIndex        =   16
      Top             =   1665
      Width           =   375
   End
   Begin VB.Label Label11 
      BackStyle       =   0  'Transparent
      Caption         =   "每题"
      Height          =   255
      Left            =   2880
      TabIndex        =   14
      Top             =   1665
      Width           =   495
   End
   Begin VB.Label Label10 
      BackStyle       =   0  'Transparent
      Caption         =   "小题"
      Height          =   255
      Left            =   1920
      TabIndex        =   13
      Top             =   1665
      Width           =   495
   End
   Begin VB.Label Label9 
      BackStyle       =   0  'Transparent
      Caption         =   "2、单选题"
      Height          =   255
      Left            =   360
      TabIndex        =   11
      Top             =   1665
      Width           =   855
   End
   Begin VB.Label Label8 
      BackStyle       =   0  'Transparent
      Caption         =   "分"
      Height          =   255
      Left            =   6120
      TabIndex        =   10
      Top             =   1125
      Width           =   375
   End
   Begin VB.Label Label7 
      BackStyle       =   0  'Transparent
      Caption         =   "共"
      Height          =   255
      Left            =   5040
      TabIndex        =   8
      Top             =   1125
      Width           =   375
   End
   Begin VB.Label Label6 
      BackStyle       =   0  'Transparent
      Caption         =   "分"
      Height          =   255
      Left            =   4200
      TabIndex        =   7
      Top             =   1125
      Width           =   375
   End
   Begin VB.Label Label5 
      BackStyle       =   0  'Transparent
      Caption         =   "每题"
      Height          =   255
      Left            =   2880
      TabIndex        =   5
      Top             =   1125
      Width           =   495
   End
   Begin VB.Label Label4 
      BackStyle       =   0  'Transparent
      Caption         =   "小题"
      Height          =   255
      Left            =   1920
      TabIndex        =   4
      Top             =   1125
      Width           =   495
   End
   Begin VB.Label Label3 
      BackStyle       =   0  'Transparent
      Caption         =   "1、判断题"
      Height          =   255
      Left            =   360
      TabIndex        =   2
      Top             =   1125
      Width           =   855
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "试卷总分"
      Height          =   255
      Left            =   3960
      TabIndex        =   1
      Top             =   480
      Width           =   735
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "试卷名称"
      Height          =   255
      Left            =   360
      TabIndex        =   0
      Top             =   480
      Width           =   855
   End
End
Attribute VB_Name = "selecttest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim objCn As New Connection, objold As Recordset
Dim ijudge() As Integer, iselone() As Integer
Dim iselmany() As Integer, ifill() As Integer, ianswer() As Integer
Dim issaved As Boolean
'判断题数据访问属性过程
Public Property Get judge() As Variant
judge = ijudge
End Property

Public Property Let judge(inew As Variant)
ijudge = inew
End Property
'单选题数据访问属性过程
Public Property Get selone() As Variant
selone = iselone
End Property
Public Property Let selone(inew As Variant)
iselone = inew
End Property
'多选题数据访问属性过程
Public Property Get selmany() As Variant
selmany = iselmany
End Property

Public Property Let selmany(inew As Variant)
iselmany = inew
End Property
'填空题数据访问属性过程
Public Property Get fill() As Variant
fill = ifill
End Property
Public Property Let fill(inew As Variant)
ifill = inew
End Property
'问答题数据访问属性过程
Public Property Get answer() As Variant
answer = ianswer
End Property
Public Property Let answer(inew As Variant)
ianswer = inew
End Property

Private Sub Form_Load()
'建立数据库连接
Set objCn = New Connection '定义并实例化连接对象
With objCn '建立连接
           .Provider = "SQLOLEDB"
           .ConnectionString = "user id=sa;data source=(local);" & _
           "initial catalog=自测考试"
           .Open
End With
'访问数据库获得判断题数据
Set objJudge = New Recordset
With objJudge
Set .ActiveConnection = objCn
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .Open "select * from 判断题"
    Set .ActiveConnection = Nothing
End With
'访问数据库获得单选题数据
Set objSelOne = New Recordset
With objSelOne
Set .ActiveConnection = objCn
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .Open "select * from 单项选择题"
    Set .ActiveConnection = Nothing
End With
'访问数据库获得多项选题数据
Set objselmany = New Recordset
With objselmany
Set .ActiveConnection = objCn
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .Open "select * from 多项选择题"
    Set .ActiveConnection = Nothing
End With
'访问数据库获得填空题数据
Set objFill = New Recordset
With objFill
Set .ActiveConnection = objCn
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .Open "select * from  填空题"
    Set .ActiveConnection = Nothing
End With
'访问数据库获得问答题数据
Set objanswer = New Recordset
With objanswer
Set .ActiveConnection = objCn
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .Open "select * from 问答题"
    Set .ActiveConnection = Nothing
End With
'访问数据库获得历届试题数据
Set objold = New Recordset
With objold
Set .ActiveConnection = objCn
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .Open "select * from 历届考题"
    Set .ActiveConnection = Nothing
    Cmbold.AddItem ""
    If .RecordCount > 0 Then
    .MoveFirst
    While Not .EOF
    Cmbold.AddItem .Fields("表名")
    .MoveNext
    Wend
    End If
    End With
    objCn.Close
End Sub
Private Sub cmdclear_Click()
Dim i%
txtname = ""
issaved = False
Cmdsave.Enabled = False
End Sub

Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set objCn = Nothing: Set objold = Nothing
Set objJudge = Nothing: Set objSelOne = Nothing
Set objselmany = Nothing: Set objFill = Nothing
Set objanswer = Nothing
End Sub




Private Sub txtname_KeyPress(KeyAscii As Integer)

If Chr(KeyAscii) Like "[0-9]" Then
KeyAscii = 0
End If
End Sub

Private Sub txtscore_Change(Index As Integer)
If Val(txtsum(Index)) <> 0 Then
   txtscores(Index) = Val(txtsum(Index)) * Val(txtscore(Index))
End If
End Sub
Private Sub txtsum_Change(Index As Integer)
If Val(txtscore(Index)) <> 0 Then
txtscores(Index) = Val(txtsum(Index)) * Val(txtscore(Index))
End If
End Sub
'检查小题分数值输入
Private Sub txtscore_KeyPress(Index As Integer, KeyAscii As Integer)
If Not (Chr(KeyAscii) Like "[0-9]" Or KeyAscii = vbKeyBack) Then
KeyAscii = 0
End If
End Sub
'检查小题数量输入
Private Sub txtsum_KeyPress(Index As Integer, KeyAscii As Integer)
If Not (Chr(KeyAscii) Like "[0-9]" Or KeyAscii = vbKeyBack) Then
KeyAscii = 0
End If
End Sub
'检查总分输入
Private Sub txttotalscore_KeyPress(KeyAscii As Integer)
If Not (Chr(KeyAscii) Like "[0-9]" Or KeyAscii = vbKeyBack) Then
KeyAscii = 0
End If
End Sub
'Private Sub txtname_Change()
'Dim m$
'm = Left(selecttest.txtName.Text, 1)
'If m Like "[0-9]" Then
'KeyAscii = 0
'End If
'End Sub

Private Function Check_Seting() As Boolean
    Dim i%, s%
    Check_Seting = False
    '检查是否正确的设置了各类型题的小题数和分数
    For i = 0 To 4
        If Val(txtsum(i)) = 0 Then
            MsgBox "请设置正确的小题数量！", vbCritical, Me.Caption
            txtsum(i).SetFocus
            Exit Function
        ElseIf Val(txtscore(i)) = 0 Then
            MsgBox "请设置正确的小题分数！", vbCritical, Me.Caption
            txtscore(i).SetFocus
            Exit Function
        End If
        s = s + Val(txtscores(i))
    Next
    '检查小题分数合计与总分是否一致
    If Val(txttotalscore) <> Val(s) Then
        MsgBox "小题分数合计与试卷总分不一致！", vbCritical, Me.Caption
        Exit Function
    End If
    '检验填空题设置是否正确
    If Val(txtdiv(0)) + Val(txtdiv(1)) * 2 + Val(txtdiv(2)) * 3 + Val(txtdiv(3)) * 4 <> Val(txtsum(4)) Then
        MsgBox "填空题设置不正确！", vbCritical, Me.Caption
        txtdiv(0).SetFocus
        Exit Function
    End If