quiz.frm

it is a quiz application

VERSION 5.00
Begin VB.Form Frmquiz 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Quiz    "
   ClientHeight    =   5070
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6030
   LinkTopic       =   "Form4"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   5070
   ScaleWidth      =   6030
   Begin VB.TextBox Text2 
      Appearance      =   0  'Flat
      BackColor       =   &H80000004&
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   960
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   11
      TabStop         =   0   'False
      Top             =   1080
      Width           =   4455
   End
   Begin VB.TextBox Text1 
      Alignment       =   2  'Center
      BackColor       =   &H80000007&
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FF00&
      Height          =   375
      Left            =   4680
      Locked          =   -1  'True
      TabIndex        =   10
      Top             =   0
      Width           =   1095
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Close"
      Height          =   495
      Left            =   3240
      TabIndex        =   9
      Top             =   4440
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Score"
      Height          =   495
      Left            =   1440
      TabIndex        =   8
      Top             =   4440
      Width           =   1215
   End
   Begin VB.Frame Frame1 
      Height          =   2535
      Left            =   240
      TabIndex        =   3
      Top             =   1680
      Width           =   5175
      Begin VB.CheckBox Check1 
         Caption         =   "Check1"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   735
         Index           =   0
         Left            =   120
         TabIndex        =   7
         Top             =   120
         Width           =   4935
      End
      Begin VB.CheckBox Check1 
         Caption         =   "Check1"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   615
         Index           =   1
         Left            =   120
         TabIndex        =   6
         Top             =   720
         Width           =   4935
      End
      Begin VB.CheckBox Check1 
         Caption         =   "Check1"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   615
         Index           =   2
         Left            =   120
         TabIndex        =   5
         Top             =   1200
         Width           =   4935
      End
      Begin VB.CheckBox Check1 
         Caption         =   "Check1"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   615
         Index           =   3
         Left            =   120
         TabIndex        =   4
         Top             =   1680
         Width           =   4935
      End
   End
   Begin VB.VScrollBar VScroll1 
      Height          =   5055
      LargeChange     =   5
      Left            =   5760
      Max             =   20
      Min             =   1
      TabIndex        =   1
      Top             =   0
      Value           =   1
      Width           =   255
   End
   Begin VB.Timer Timer1 
      Interval        =   2000
      Left            =   4080
      Top             =   0
   End
   Begin VB.Label Label3 
      Alignment       =   2  'Center
      Caption         =   "1"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   360
      TabIndex        =   2
      Top             =   1080
      Width           =   375
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Caption         =   "Quiz"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2280
      TabIndex        =   0
      Top             =   480
      Width           =   855
   End
End
Attribute VB_Name = "Frmquiz"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'************************************************
'A 3 minute 20 question quiz with top-scores   **
'And ability to add,delete and select questions**
'Program By Sachin Palewar                     **
'E-Mail [e-mail]                    **
'URL :- http://members.tripod.com/compuwhizkid **
'************************************************
Dim min As Byte, sec As Byte 'Used for keeping track of remaining time.
Dim db As Database
Dim rec As Recordset
Dim selquestion(1 To 20) As Byte 'Keeps qno of selected questions
Dim attempted(19) As String 'Stores Answers of user
Dim topplayer As String 'Stores Name of Topscorer

Private Sub Check1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
attempted(Val(Label3.Caption) - 1) = Trim(Str(Check1(0).Value)) + Trim(Str(Check1(1).Value)) + Trim(Str(Check1(2).Value)) + Trim(Str(Check1(3).Value))
For i = 1 To 19
If attempted(i) = "0000" Then 'If all the questions are not attempted then
                              'Score Commandbutton should remain disabled
Command1.Enabled = False
Else: Command1.Enabled = True
End If
Next
End Sub

Private Sub Command1_Click()
If score >= tops Then 'Checks If user's score qualifies for a top score
topplayer = InputBox("Please Enter Your Name", "Congratulations!! You Are Now A Top Scorer")
End If
msg = MsgBox("You Scored " + Str(score) + " out of 20" + Chr(13) + "Restart Quiz?", vbYesNo, "Your Score")
If msg = vbYes Then
If topplayer <> "" Then updatetop 'Updates Top5 table
Initialize
    Else
       If topplayer <> "" Then updatetop
 Unload Frmquiz
End If
End Sub


Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Form_Load()
Initialize
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set rec = Nothing
Set db = Nothing
End Sub

Private Sub Timer1_Timer()
'This sub Displays remaining time on the form
If min = 0 And sec = 0 Then
If score >= tops Then
topplayer = InputBox("Please Enter Your Name", "Congratulations!! You Are Now A Top Scorer")
End If
msg = MsgBox("You Scored " + Str(score) + " out of 20" + Chr(13) + "Restart Quiz?", vbYesNo, "Time Over")
If msg = vbYes Then
        If topplayer <> "" Then updatetop
Initialize
    Else
        If topplayer <> "" Then updatetop
 Unload Frmquiz
    End If
    Exit Sub
     End If
If sec = 0 Then
sec = 58
min = min - 1
End If
sec = sec - 2
 If topplayer <> "" Then updatetop
 If sec < 10 Then Text1 = Trim("0") + Trim(Str(min)) + ":" + Trim("0") + Trim(Str(sec)): Exit Sub
 Text1 = Trim("0") + Trim(Str(min)) + ":" + Str(sec)
End Sub
Sub showrecord(n As Byte) 'Displays question with qno=n
Set rec = db.OpenRecordset("select * from question where qno=" & selquestion(n))
With Frmquiz
.Text2 = rec!question
.Check1(0).Caption = rec!ans1
.Check1(0).Value = Val(Mid(attempted(n - 1), 1, 1))
.Check1(1).Caption = rec!ans2
.Check1(1).Value = Val(Mid(attempted(n - 1), 2, 1))
.Check1(2).Caption = rec!ans3
.Check1(2).Value = Val(Mid(attempted(n - 1), 3, 1))
.Check1(3).Caption = rec!ans4
.Check1(3).Value = Val(Mid(attempted(n - 1), 4, 1))
.Label3.Caption = n
End With
End Sub

Private Sub VScroll1_Change()
showrecord (VScroll1.Value)
End Sub

Private Sub VScroll1_Scroll()
showrecord (VScroll1.Value)
End Sub
Function score() As Byte 'Returnes user's current score
Dim scor As Byte
Dim i As Byte
For i = 1 To 20
Set rec = db.OpenRecordset("select ans from question where qno=" & selquestion(i))
If rec!ans = attempted(i - 1) Then scor = scor + 1
Next
score = scor
End Function
Sub Initialize() 'Starting routine
Dim i As Byte
Dim j As Byte
topplayer = ""
min = 3
sec = 0
Text1 = "03:00"
j = 0
For i = 0 To 19
attempted(i) = "0000"
Next
Command1.Enabled = False
Set db = OpenDatabase("quiz.mdb", False, False, ";pwd=ssr2197")
Set rec = db.OpenRecordset("select qno from question where selected=true order by qno")
rec.MoveFirst
While rec.EOF = False
j = j + 1
selquestion(j) = rec!qno
rec.MoveNext
Wend
VScroll1.Value = 1
showrecord (1) 'Show first question
End Sub
Function tops() As Byte 'Returnes lowest topscore from table
Set rec = db.OpenRecordset("select tscore from top5 order by tscore")
rec.MoveFirst
tops = rec!tscore
End Function
Sub updatetop() 'Updates Top Score table
Dim res As Recordset
Set res = db.OpenRecordset("select * from top5 order by tscore")
res.MoveFirst
res.Edit
res!Name = topplayer
res!tscore = score
res.Update
End Sub