Visual Basic Projects

WritePrivateProfileString: Creating a Quiz Application
Step 4: Building the Main Quiz Form
Posted:   Tuesday August 24, 1999
Updated:   Monday December 26, 2011
Applies to:   VB4-32, VB5, VB6, and VB3, VB4-16 with appropriate declarations
Developed with:   VB6, Windows NT4
OS restrictions:   None
Author:   VBnet - Randy Birch
 Other project pages:   Step 1: Introduction and BAS Module
Step 2: Building the 'TopScores' Form
Step 3: Building the Quiz Topic Selection Form
Step 4: Building the Main Quiz Form
Form Illustration Layouts
Downloadable KidzQuiz INI file


WritePrivateProfileString: INI Files - The Basics
WritePrivateProfileString: INI Files - Saving Entire Sections
Steps 1, 2 and 3 completed.

This is the main form for the application, and contains all the logic to determine correct answers, show the correct one when wrong, load the data from the ini file and call the parsing methods, and is responsible determining whether a high score worthy of adding to the list was achieved, and if so calling the Top Scores form.

The first illustration shows the design-time layout with each  control's name as its caption, while the illustration below shows it as it is in my project.

Note that the two command buttons in the frame - cmdSubmit and cmdNext, are physically aligned in the illustration below. cmdSubmit should be set as the topmost control. And while there appears to be a ton'o'code below don't panic - a good portion of the text below are code comments.


kidz1blayout.gif (5720 bytes)

 Form Code: frmQuiz
Add the final form to the project and name it frmQuiz.

On the form add three command buttons (cmdNew, cmdTopScores, and cmdQuit). Also add a series of labels (their names are not important) and set their captions as indicated above - 'Category', 'Question' and 'Your Score'. Now add three more auto-sizing labels that have their captions set in code - name those lbCategory, lbQuestionNo and lbScore and position appropriately beside the other labels you added.

Add a frame to the form (frAnswers), and onto it draw the two command buttons (cmdSubmit and cmdNext).  Position one overtop each other -- the code shows/hides the required button as needed.

Also create, again inside the frame, five option buttons in a control array (optAnswers(0) through optAnswers(4).  You can delete optAnswers(0 as its not used, or simply set its visible property to False. To test that you've correctly create the controls inside the frame, try moving the frame around. If you've created it correctly, all the frame's controls will move as well.  If one or more don't move with the frame, you've created the controls on the from, so simply select them, cut, click anywhere inside the frame, paste, and position.

Finally, inside the frame add two labels (lbQuestion and lbMessage) in which the question and the answer/prompt are displayed. You can add labels for the A/B/C/D captions as desired. Also, position the two command buttons overtop each other, assuring that cmdSubmit is the topmost button.

There are two unseen controls on this form, shown in the yellow rectangle in the layout illustration above. The first is a timer - Timer1 - used exclusively when a wrong answer is given (see the cmdSubmit routine below). The other control is a command button that should be move out of view (but not made invisible!!), and given the name cmdDummy. Its not used to execute any code ... its sole purpose is to have a control off-screen to which focus can be set when resetting (de-selecting) the question option buttons so as not provide any clue or misleading information as to what might be the expected answer.

Add the following to this form:

Option Explicit
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
'Constants for the questions array. By using variables,
'we make the array dynamic, and in doing so assure it
'doesn't occupy the 64k of memory normally reserved
'for form-level code and strings.
'The data is stored in the array as follows:

' - assume there are 15 questions
' - the first dimension always has 6 elements:
'     element 1 - the correct answer index
'     element 2 - the question
'     element 3 - answer option A
'     element 4 - answer option B
'     element 5 - answer option C
'     element 6 - answer option D

' - the second dimension of the array is always
'   the index to the current question (of the 15 available).

'Therefore, in assigning the data to the array,
'the following methodology is used:

'Assuming the current question (currQuestion) was 1 ...
'   Q1=3,What does the prefix pre mean?,after,seldom,before,rapid
'...the data is assigned as follows :

'questions(Correct,  currQuestion) = 3 'index to the correct response
'questions(Question, currQuestion) = "What does the prefix pre mean?"
'questions(AnswerA,  currQuestion) ="after"
'questions(AnswerB,  currQuestion) ="seldom"
'questions(AnswerC , currQuestion) ="before"
'questions(AnswerD,  currQuestion) ="rapid"

'Since the indices of the answer option buttons are
'also 1 through 4, the code simply uses the selected
'index and compares it to the value stored at 'Correct'..
'(that's why optAnswers(0) was deleted or hidden and not used!)
'i.e. isRight = AnswerGiven = questions(Correct, currQuestion)

'The lower bounds of both dimensions of the questions array
Private Const firstNo As Long = 1

'The upper bounds of the first dimension of the questions 
'array.  The upper bound of the second dimension is set 
'in code via the BeginQuiz routine, and the value is 
'determined according to the number of Quiz questions 
'under the Quiz topic selected.
Private Const lastNo As Long = 6

'Just to make keeping track of the item in the questions
'array currently being used a little easier, declare constants
'representing the info in each position.  This will correspond
'to the way the data is stored in the ini file.
Private Const Correct As Long = 1
Private Const Question As Long = 2
Private Const AnswerA As Long = 3
Private Const AnswerB As Long = 4
Private Const AnswerC As Long = 5
Private Const AnswerD As Long = 6

'finally, we need ...
' ThisQuestion:   a form-level variable to track the current question
' TotalQuestions: a form-level variable to hold the total questions
' AnswerGiven:    a form-level variable to hold the submitted answer
' TotalScore:     a form-level variable for the current score.
Private ThisQuestion     As Long
Private TotalQuestions   As Long
Private AnswerGiven      As Long
Private TotalScore       As Long

Private Sub cmdNew_Click()

'This sub displays the question category list, then
'loads the ini questions & answers, and begins the test

 'the section in the ini file with the questions
  frmSelect.Show vbModal, Me
  If iniQuizSection = "" Then
     Exit Sub
  End If
 'if no questions were loaded, in BeginQuiz, then
 'TotalQuestions = 0 else TotalQuestions = no of
 'questions loaded.
  TotalQuestions = BeginQuiz(iniQuizSection)

  If TotalQuestions Then
   'reset remaining variables
    ThisQuestion = 0
    TotalScore = 0
   'update the labels with the startup data
    lbCategory = iniQuizSection
    lbQuestionNo = CStr(ThisQuestion) & " of " & CStr(TotalQuestions)
    lbScore = TotalScore

   'show the first question
   'and enable the frame and buttons to
   'allow answering
    frAnswers.Enabled = True
  End If

End Sub

Private Sub cmdNext_Click()
 'when the Next Question button is pressed...
End Sub

Private Sub cmdQuit_Click()
 'we're done, so shut down
  Unload frmHiScores
  Erase Questions
  Unload Me
End Sub

Private Sub cmdSubmit_Click()

'this sub is called when "Am I Right ?" is pressed
 'working variables
  Dim CorrectAnswer As Long
  Dim msg As String

 'determine what the the correct answer should be
  CorrectAnswer = Val(Questions(Correct, ThisQuestion))

 'and compare to the selected answer
 'AnswerGiven is set when the kids click an
 'option button from the optAnswers_Click sub
  If AnswerGiven = CorrectAnswer Then
   'got it correct, so say so, and update score
    lbMessage = "Correct !!"
    TotalScore = TotalScore + 1
    lbScore = TotalScore
   'do a quick check to determine if there are
   'more questions to show.
    If CheckQuestionStatus = False Then
      frAnswers.Enabled = False
      Exit Sub     'nope, we're done
    End If
   'show the "next question" button, and
   'assure it is at the top of the ZOrder
    cmdNext.ZOrder 0
    cmdNext.Visible = True
  Else 'wrong answer, so indicate the correct one
   'Build the answer string to display.
   'the correct answer's "a,b,c or d" can be determined by
   'taking the chr$ value of 96 (the character just before
   ''a' in the ASCII chart), and adding the correct
   'answer number (1 through 4), to give the
   'characters a, b, c, d)
   'This is the equivalent of using:
     ' if CorrectAnswer = 1 then msg = "a )"
     ' if CorrectAnswer = 2 then msg = "b )" ... etc
    msg = Chr$(96 + CorrectAnswer) & " )  "
   'the correct answer strings begin at Questions() array
   'position 3 (Const AnswerA = 3), but the answer
   'option buttons begin at index 1, so we have to add 2
   'to the answer to display the correct answer string.
    msg = msg & Questions(CorrectAnswer + 2, ThisQuestion)
   'show the correct answer in a label, and call a little
   'routine to highlight the correct answer option button
   'in bold.
    lbMessage = "Sorry. The correct answer is " & msg
    HighlightAnswer CorrectAnswer

   'do a quick check to determine if there are
   'more questions to show.
    If CheckQuestionStatus = False Then
      frAnswers.Enabled = False
      Exit Sub 'done
    End If
   'because they made a wrong answer, pause so they
   'can read the correct answer before continuing.
   'Incrementing the Interval below by 1000 adds approx. 1 second.
    Timer1.Interval = 3000  'pause about 2-3 seconds
    Timer1.Enabled = True   'turn on the timer.
                            'In the Timer1_Timer sub, once
                            'the interval set above has elapsed,
                            'it will shut itself off, and make the
                            'Next Question button visible.

  End If
 'disable until a new answer is selected
  cmdSubmit.Enabled = False

End Sub

Private Sub cmdTopScores_Click()

 'show the top scores dialog
  frmHiScores.Show 1

End Sub

Private Sub Form_Load()

 'centre this form on the screen
  Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2

 'disable the answer frame & buttons
  cmdSubmit.Enabled = False
  frAnswers.Enabled = False
  cmdNext.Visible = False

 'set the name of the file containing the 'high scores'
  sHighScoreFile = App.Path & "\" & "qscores.dat"
 'set the name of the file containing the questions
  sIniQFile = App.Path & "\" & "kidquiz.ini"
 'have to force the form on-screen before
 'setfocus can be used

End Sub

Private Function BeginQuiz(iniQuizSection As String) As Long

 'Step 1 - declare working variables for this sub
  Dim qiCount       As Long     'counter for the "question item"
  Dim currQuestion  As Long     'counter for the actual question in process
  Dim item          As String   'value returned from the ini file, minus the trailing null
  Dim sKeyData      As String   'key in the ini file currently being processed
  Dim ret           As String   'string returned from the API call currently being processed
  Dim x             As String   'extracted string
  Dim r             As Long     'return var for API calls
 'Step 2 - set starting variables for this routine

 'update the current question counter counter variable is 0
 'and erase the array containing any previous questions
  currQuestion = 0
  Erase Questions
 'Step 3 - assure that the specified ini file exists
  If Not FileExists(sIniQFile) Then
    MsgBox "The quiz file..." & vbCrLf & vbCrLf & _
            sIniQFile & vbCrLf & vbCrLf & "...was not found.", _
            vbExclamation Or vbOKOnly, "Quiz Error"
    BeginQuiz = False
    Exit Function
  End If
 'Step 4 - get the keys in the ini file.  Using this call
 'removes the requirement of knowing and hard coding the
 'actual keys, and the number of them.
 'First, get all the item keys for the given section.
 'In the ini file kidquiz.ini, this call returns all
 'the items to the left of the = signs (Q1, Q2, Q3 etc),
 'in other words the keys that we use later to retrieve
 'the actual individual data.
 'pad a string large enough for the returned string
  ret = Space(2048)
 'and get the keys
  r = GetPrivateProfileString(iniQuizSection, _
                                     0&, _
                                     "", _
                                     ret, _
                                     Len(ret), _
 'if r > 0, then r = the number of characters
 'in the returned string.  With this info, we extract each
 'key item individually, call GetPrivateProfileString again
 'with that value to obtain the question and answers for each key.
  If r Then
   'strip the terminating null character
    ret = Left(ret, r)
   'and get each question & answer set
    Do Until ret = ""
       'get 1 key item (ie Q1)
        item = ppStripItem(ret)
       'and retrieve its related info by calling a
       'GetPrivateProfileString 'wrapper' function
        sKeyData = ppGetItemsInfo(iniQuizSection, item, sIniQFile)
        'make sure there is a valid string
         If Len(Trim(sKeyData)) > 0 Then
           'at this point, we have a string (such as the first Q1 entry)
           ' " What does the prefix pre mean?,after,seldom,before,rapid "
           'We now need to do another loop with this string, parsing out
           'each item, and assigning it to the questions() array for
           'later use.
           'assure that the "question item" counter variable is 0
            qiCount = 0
           'update the current question counter by 1
            currQuestion = currQuestion + 1
           'and redim the questions() array for the new question & answer,
           'preserving the present contents, if any
            ReDim Preserve Questions(firstNo To lastNo, _
                                     firstNo To currQuestion) As String
            Do Until sKeyData = ""
                x = ppExtractItem(sKeyData)
               'Again, assure x is a valid string
                If Len(Trim(x)) > 0 Then
                 'it is, so update the "question item" counter
                  qiCount = qiCount + 1
                  Questions(qiCount, currQuestion) = x
                End If
         End If
  'return the number of questions loaded
    BeginQuiz = currQuestion
     BeginQuiz = False 'some error happened, so return 0
  End If
End Function

Private Sub ShowQuestion()

'This sub displays each question
 'working variables
  Dim i As Long
 'double check that this isn't the last question.
  If ThisQuestion < TotalQuestions Then
   'update the current question counter
    ThisQuestion = ThisQuestion + 1
   'hide the "next question" button
    cmdNext.Visible = False

   '1. reset the option button values to normal
   '   display mode, with nothing selected.
   '2. Show the question using the counter.
   'Because the answer strings begin at Questions() array
   'position 3 (Const AnswerA = 3), we have to add 2
   'to the loop index to display the correct answer string.
    For i = 1 To 4
      optAnswers(i).Font.Bold = False
      optAnswers(i).Value = False
      optAnswers(i).Caption = Questions(i + 2, ThisQuestion)
      optAnswers(i).Enabled = True
    Next i
   'disable the submit button until an 
   'option button is selected
    cmdSubmit.Enabled = False
   'display the question
    lbQuestion.Caption = Questions(Question, ThisQuestion)
   'display the question number
    lbQuestionNo.Caption = CStr(ThisQuestion) & " of " & CStr(TotalQuestions)
   'and remove any present correct/wrong message
    lbMessage.Caption = ""
  Else 'This should never fire ...
      MsgBox "Counter Error in sub ShowQuestion ... an attempt was " & _ 
             "made to display question #" & _
              CStr(ThisQuestion) & " when there are only" & _
              CStr(TotalQuestions) & " loaded.", _
              vbExclamation Or vbOKOnly, "VBnet INI Demo - Kidz Quiz"
  End If
 'assure focus is removed from all the option
 'buttons by forcing focus onto a 'dummy' command
 'button off-screen (maximize form to see it).

End Sub

Private Sub optAnswers_Click(Index As Integer)

 'an answer was selected, so enable the submit button
  cmdSubmit.Enabled = True
 'and set the form-level variable to the answer selected
  AnswerGiven = Index
End Sub

Private Sub HighlightAnswer(Correct As Long)

 'Once an answer has been submitted, and it was
 'deemed incorrect, this routine dims the wrong
 'answers and highlights the correct one by bolding it.
 'working variable
  Dim cnt As Long
 'loop through the option buttons.  If the
 'loop counter matches the correct answer,
 'switch it to bold text, and select it by
 'setting its value to true, otherwise
 'dim the wrong answer
  For cnt = 1 To 4
    optAnswers(cnt).Value = cnt = Correct
    optAnswers(cnt).Enabled = cnt = Correct
    optAnswers(cnt).Font.Bold = cnt = Correct

  Next cnt

End Sub

Private Sub Timer1_Timer()

 'turn off the timer
  Timer1.Enabled = False
 'and show the "next question" button,
 'assuring its at the top of the ZOrder
  cmdNext.ZOrder 0
  cmdNext.Visible = True
  lbMessage = ""
End Sub

Private Function CheckQuestionStatus() As Long

'This first compares the current question
'(ThisQuestion) with the TotalQuestions.

'If equal, it processes the score, and creates a
'custom message based on the score, and displays it.
'Additionally, it has a flag called GoodEnoughToAddToList,
'which defaults to true. However, based on how high a
'score was achieved, you can set any level to be false.
'Setting False will prevent the "Add Name to Top Scores"
'dialog from appearing at the end of the questioning.
'Perhaps this might be an incentive to work harder.
 'working variables
  Dim msg As String
  Dim percentRight As Long
  Dim tutor As String
  Dim title As String
  Dim iconVal As String
  Dim GoodEnoughToAddToList As String
  If ThisQuestion = TotalQuestions Then
     'we're done the quiz, so say so...
     'determine the percentage correct based on
     'the number of questions, and the number correct
      percentRight = (TotalScore / TotalQuestions) * 100
     'create a generic first-part of the message
      msg = "The quiz is over." & vbCrLf & vbCrLf
      msg = msg & "You scored " & CStr(TotalScore) 
      msg = msg & " out of a possible " & CStr(TotalQuestions) 
      msg = msg & " points." & vbCrLf 
      msg = msg & "That is " & CStr(percentRight) 
      msg = msg & " percent correct." & vbCrLf & vbCrLf      
     'set a couple of default values- lets assume they're not fools
      title = "Kidz Quiz"
      GoodEnoughToAddToList = True
     'and create the custom portion of the message
      Select Case percentRight
        Case Is > 90: 
          tutor = "Congratulations .. Well done! Top 10 of the Class!"
          title = "Kidz Quiz Master!"
          iconVal = vbExclamation
        Case Is > 75: 
          tutor = "Congratulations! You scored in the top 25."
          iconVal = vbExclamation
        Case Is > 65: 
          tutor = "Well done.  Maybe next time you'll make 100!"
          iconVal = vbInformation
        Case Is > 50: 
          tutor = "Good try.  Maybe next time you'll make 100!"
          iconVal = vbInformation
        Case Is > 25: 
          tutor = "More work is needed this term to break 50."
          iconVal = vbQuestion
          GoodEnoughToAddToList = False
        Case Is <= 25: 
          tutor = "You need to do a lot more work this term."
          iconVal = vbCritical
          GoodEnoughToAddToList = False
      End Select
     'build the final message and show it
      msg = msg & tutor
      MsgBox msg, iconVal, "Quiz Machine"
     'If they were GoodEnoughToAddToList, initiate the routines
     'to add the name to the winner's list.
      If GoodEnoughToAddToList Then AddPlayerToList percentRight
       'no more questions, so return false
        CheckQuestionStatus = False
  Else: CheckQuestionStatus = True  'still more questions
  End If
End Function

Private Function AddPlayerToList(percentRight As Long)

 'Here we set a flag to tell the high scores
 'form to display the Add Name dialog.  Then we
 'call the HiScores dialog.  On showing, its
 'Activate Sub has code that displays the
 'Add Name dialog if GetHiScoreNameFlag is > 0.
 'By passing the percentRight, the sub can
 'use it to display in its congratulatory message
  GetHiScoreNameFlag = percentRight
 'and just show the high scores dialog
  frmHiScores.Show vbModal

End Function
This is the last project file. You can download a sample INI file from this link, or, give the exe version of this app a test drive (VB6 only). Place the sample ini file into the same folder as you project files, then give the app a run.


PayPal Link
Make payments with PayPal - it's fast, free and secure!


Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy


Hit Counter