'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
    ShowQuestion
    
   '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...
  ShowQuestion
  
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
  Show
  cmdNew.SetFocus

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), _
                                     sIniQFile)
   
 '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
            Loop
            
            
         End If
    Loop
       
  'return the number of questions loaded
    BeginQuiz = currQuestion
  
  Else
     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 for..next 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).
  cmdDummy.SetFocus

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