frmfilltest.frm

网上收集的一个考试管理系统。带论文的

VERSION 5.00
Begin VB.Form FrmFillTest 
   BackColor       =   &H00808080&
   BorderStyle     =   0  'None
   Caption         =   "填空题"
   ClientHeight    =   7530
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   10095
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7530
   ScaleWidth      =   10095
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton Command1 
      Caption         =   "做好了"
      Height          =   330
      Left            =   7515
      TabIndex        =   8
      Top             =   6345
      Width           =   1635
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Index           =   0
      Left            =   225
      TabIndex        =   6
      Top             =   5040
      Visible         =   0   'False
      Width           =   1590
   End
   Begin VB.TextBox Text1 
      Appearance      =   0  'Flat
      BackColor       =   &H00FFFFFF&
      ForeColor       =   &H00FF0000&
      Height          =   3840
      Left            =   180
      Locked          =   -1  'True
      MousePointer    =   99  'Custom
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   4
      Top             =   810
      Width           =   9780
   End
   Begin VB.Data Data1 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   "F:\My Documents\VB\考试管理系统\examktl.dll"
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   345
      Left            =   3690
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   "FillSubject"
      Top             =   6840
      Visible         =   0   'False
      Width           =   2085
   End
   Begin VB.CommandButton Command2 
      Caption         =   "最后"
      Height          =   330
      Index           =   3
      Left            =   5805
      TabIndex        =   3
      Top             =   6345
      Width           =   1140
   End
   Begin VB.CommandButton Command2 
      Caption         =   "下一题"
      Height          =   330
      Index           =   2
      Left            =   4680
      TabIndex        =   2
      Top             =   6345
      Width           =   1140
   End
   Begin VB.CommandButton Command2 
      Caption         =   "上一题"
      Height          =   330
      Index           =   1
      Left            =   3555
      TabIndex        =   1
      Top             =   6345
      Width           =   1140
   End
   Begin VB.CommandButton Command2 
      Caption         =   "第一题"
      Height          =   330
      Index           =   0
      Left            =   2430
      TabIndex        =   0
      Top             =   6345
      Width           =   1140
   End
   Begin VB.Shape Shape2 
      BorderColor     =   &H00C0C0FF&
      Height          =   240
      Left            =   9675
      Top             =   45
      Width           =   330
   End
   Begin VB.Label Label4 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "×"
      ForeColor       =   &H008080FF&
      Height          =   150
      Left            =   9720
      TabIndex        =   9
      Top             =   90
      Width           =   240
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "请在下面空格答题依次从左到右与题目上的标号次序一致"
      ForeColor       =   &H000000C0&
      Height          =   180
      Left            =   270
      TabIndex        =   7
      Top             =   4725
      Width           =   4500
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "填 空 题"
      Height          =   285
      Left            =   3240
      TabIndex        =   5
      Top             =   90
      Width           =   3030
   End
   Begin VB.Shape Shape1 
      BackColor       =   &H0000FFFF&
      BackStyle       =   1  'Opaque
      BorderColor     =   &H0000FFFF&
      Height          =   330
      Left            =   0
      Top             =   0
      Width           =   10095
   End
   Begin VB.Line Line1 
      BorderColor     =   &H0000FFFF&
      X1              =   0
      X2              =   0
      Y1              =   315
      Y2              =   9000
   End
   Begin VB.Line Line2 
      BorderColor     =   &H0080FFFF&
      X1              =   10125
      X2              =   90
      Y1              =   7515
      Y2              =   7515
   End
   Begin VB.Line Line3 
      BorderColor     =   &H0080FFFF&
      X1              =   10080
      X2              =   10080
      Y1              =   7515
      Y2              =   0
   End
End
Attribute VB_Name = "FrmFillTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim CurrentT As Integer
Dim ResultNum As Integer
Public TWForm As New TransWindow
Private Sub Command1_Click()
TWForm.UnLoadForm
Me.Hide
End Sub

Private Sub Command2_Click(Index As Integer)
For i = 0 To Text2.Count - 1 '答题初始化
   Text2(0).Text = ""
Next i

Select Case Index
       Case 0
             CurrentT = 0
       Case 1
              CurrentT = CurrentT - 1
             If CurrentT < 0 Then: CurrentT = 0
       Case 2
              CurrentT = CurrentT + 1
             If CurrentT >= FillSubjectCount Then: CurrentT = FillSubjectCount - 1
       Case 3
             CurrentT = FillSubjectCount - 1
End Select
       

ViewSubject CurrentT
End Sub

Private Sub Form_Activate()
 ViewSubject CurrentT
End Sub

Private Sub Form_Load()
TWForm.SetForm Me

Data1.DatabaseName = App.Path & "\examktl.dll"
CurrentT = 0
Call Init
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
TWForm.UnLoadForm
Set TWForm = Nothing
End Sub

Private Sub Label4_Click()
Me.WindowState = 1
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label4.ForeColor = &H8080FF
Shape2.BorderColor = &HC0C0FF
Label4.MousePointer = 0
End Sub


Private Sub Label4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label4.ForeColor = vbRed
Shape2.BorderColor = vbRed
Label4.MousePointer = 99
End Sub


Sub ViewSubject(SubjectIndex As Integer)
On Error Resume Next
Dim Result() As String
    Text1.Text = "第 " & SubjectIndex + 1 & " 题" & vbCrLf

    SubjectMove FillSubject(SubjectIndex)


    Text1.Text = Text1.Text & CheckSubject(Data1.Recordset.Fields(0), Data1.Recordset.Fields(1))
    Call ViewFillResult '显示填答案位置
    
    If Len(FillSelectQuestion(SubjectIndex)) <> 0 Then
       Result = Split(FillSelectQuestion(CurrentT))
        
       For i = 0 To Text2.Count - 1
        Text2(i) = Result(i)
       Next i
    End If
      
End Sub

Sub SubjectMove(SubjectIndexR As Long)
Data1.Refresh
Data1.Recordset.MoveFirst
Data1.Recordset.Move SubjectIndexR
End Sub

Function CheckSubject(cMemo As String, Sign As String) As String
Dim txtCurrentPos As Integer
Dim txtMemo As String
Dim txtSubject As String
Dim txtResult As String
Dim txtNextPos As Integer

txtMemo = Trim(cMemo)
ResultNum = 0
  Do While txtMemo <> Empty
       txtCurrentPos = 1
       txtNextPos = InStr(txtCurrentPos, txtMemo, Sign)
       If txtNextPos = 0 Then
          txtSubject = txtSubject & Mid(txtMemo, txtCurrentPos) & " "
       Exit Do
       End If
       
       txtSubject = txtSubject & Mid(txtMemo, txtCurrentPos, txtNextPos - 1) & "__" & ResultNum + 1 & "__" & " "
       ResultNum = ResultNum + 1
       txtMemo = Mid(txtMemo, txtNextPos + 1)
 
 Loop
CheckSubject = txtSubject
End Function

Sub ViewFillResult()
Dim col As Integer
Dim raw As Integer
    col = 0
    raw = 0
    For i = Text2.Count - 1 To 1 Step -1
          Unload Text2(i)
    Next i
    
    For i = 0 To ResultNum - 1
       If i <> 0 Then
            Load Text2(i)
       End If
       If col = 3 Then
         col = 0
          raw = raw + 1
       End If
          Text2(i).Left = Text2(0).Left + Text2(0).Width * col
          Text2(i).Top = Text2(0).Top + Text2(0).Height * raw
          Text2(i).Visible = True
        col = col + 1
    Next i
End Sub

Private Sub Text2_LostFocus(Index As Integer)
Dim FillSelect As String

  For i = 0 To Text2.Count - 1
     If Text2(i).Text = Empty Then
       FillSelect = FillSelect & "0" & " "
     Else
      FillSelect = FillSelect & Text2(i).Text & " "
     End If
   Next i
   
   SelectAnswer FillSelect

End Sub
Sub SelectAnswer(Answer As String)

Data1.Recordset.Edit
Data1.Recordset.Fields(3) = Answer


Data1.UpdateRecord

 FillSelectQuestion(CurrentT) = Answer


End Sub

Sub Init()
On Error Resume Next
    For i = 0 To UBound(FillSubject)
       SubjectMove FillSubject(i)
       FillSelectQuestion(i) = Data1.Recordset.Fields(3)
       FillRightQuestion(i) = JieMi(Data1.Recordset.Fields(2), Data1.Recordset("key"))
    Next i
     
End Sub