"Mohammed Mazid" <ka******@hotmail.com> wrote in message
Hi folks!
Can anyone please help me with this?
I am developing a Quiz program but I am stuck with "multiple answers".
Basically I need some sort of code that would select multiple answers
using check boxes.
See if you can learn from the following code. Add a Checkbox to a new
form and set its Index property to 0, then add a Command button to the
form and paste in the code below. I've left Debug statements in, so
watch the debug window for clues.
HTH
LFS
Option Explicit
Private Type MyRecordType
A As String
B As String
C As String
D As String
E As String
F As String
Q As String
Z As Long
End Type
Private Type MyQuestionType
A As String
B As String
C As String
D As String
Q As String
Z As Long
End Type
Dim Records(0 To 2) As MyRecordType
Dim Question As MyQuestionType
Dim QCount As Long
Private Sub Form_Load()
Dim i
Randomize
Show
' These are your DB records
With Records(0)
.Q = "Which of these are colors"
.A = "Red" ' 1
.B = "White" ' 2
.C = "Blue" ' 4
.D = "Car" ' 8
.E = "House" ' 16
.F = "Plane" ' 32
.z = 7 ' 1 + 2 + 4 (Right answers)
End With
With Records(1)
.Q = "Which of these are numbers"
.A = "Two"
.B = "One"
.C = "Tree"
.D = "Red"
.E = "Plant"
.F = "Man"
.z = 3
End With
With Records(2)
.Q = "Which of these are mostly water"
.A = "Lake"
.B = "River"
.C = "Car"
.D = "Key"
.E = "House"
.F = "Fan"
.z = 3
End With
Command1.Move 120, 1800, 1200, 480
' Make more checkboxes
For i = 0 To 3
If i Then
Load Check1(i)
Check1(i).Visible = True
End If
Check1(i).Move 220, i * 300 + 400, 4000, 300
Next i
GenerateQ
ShowQ
End Sub
Private Sub Command1_Click()
Dim z, i
Select Case Command1.Caption
Case "Guess"
' Tally answer
For i = 0 To 3
If Check1(i).Value = vbChecked Then
z = z Or (2 ^ i)
End If
Next
If z = Question.z Then
Caption = "Correct!"
Else
Caption = "Wrong"
End If
Command1.Caption = "Next"
Case Else ' "Next"
GenerateQ
ShowQ
End Select
End Sub
Private Sub ShowQ()
With Question
Cls
PSet (90, 90)
Print .Q
Check1(0).Caption = .A
Check1(0).Value = vbUnchecked
Check1(1).Caption = .B
Check1(1).Value = vbUnchecked
Check1(2).Caption = .C
Check1(2).Value = vbUnchecked
Check1(3).Caption = .D
Check1(3).Value = vbUnchecked
End With
Command1.Caption = "Guess"
Caption = "Answer question"
End Sub
Private Sub GenerateQ()
Dim R As MyRecordType
Dim quiz(0 To 3) As String
Dim Txt As String
Dim Cnt As Long, z As Long, used As Long
Dim Que As Long
Dim blank As MyQuestionType
' Pull next question from records
QCount = QCount + 1
If QCount > 2 Then QCount = 0
R = Records(QCount)
' Init Question
Question = blank
Question.Q = R.Q
Debug.Print vbCrLf & "Correct ansers:"
' Pick random # of right answers
Cnt = Int(Rnd * 3) + 1
Do While Cnt
' Pick random answer
z = 2 ^ (Int(Rnd * 6))
' Test if a 'correct' answer AND not used
If (R.z And z) > 0 And (used And z) = 0 Then
' Saved picked
used = used Or z
' Pick random unused spot
Do
Que = Int(Rnd * 4)
Loop Until Len(quiz(Que)) = 0
' Move to Quiz
Select Case z
Case 1
quiz(Que) = R.A
Case 2
quiz(Que) = R.B
Case 4
quiz(Que) = R.C
Case 8
quiz(Que) = R.D
Case 16
quiz(Que) = R.E
Case 32
quiz(Que) = R.F
End Select
Debug.Print Que, quiz(Que)
' Decrement answer counter
Cnt = Cnt - 1
' Test if all 'correct' answers picked
If used = R.z Then Cnt = 0
End If
Loop
'Remove all other correct answers
used = used Or R.z
Debug.Print Question.Q
' fill with guesses
Cnt = 0
For Que = 0 To 3
If Len(quiz(Que)) = 0 Then
' Pick guess (wrong answer)
Do
z = 2 ^ (Int(Rnd * 6))
Loop While (used And z) > 0
' Mark as used
used = used Or z
' Move to Quiz
Select Case z
Case 1
quiz(Que) = R.A
Case 2
quiz(Que) = R.B
Case 4
quiz(Que) = R.C
Case 8
quiz(Que) = R.D
Case 16
quiz(Que) = R.E
Case 32
quiz(Que) = R.F
End Select
Else
' Tally right answers
Cnt = Cnt Or (2 ^ Que)
End If
Debug.Print Que, quiz(Que), 2 ^ Que
Next
Debug.Print "Right value >", , Cnt
'Move to Question
With Question
.A = quiz(0)
.B = quiz(1)
.C = quiz(2)
.D = quiz(3)
.z = Cnt
End With
End Sub
-----= Posted via Newsfeeds.Com, Uncensored Usenet News =-----
http://www.newsfeeds.com - The #1 Newsgroup Service in the World!
-----== Over 100,000 Newsgroups - 19 Different Servers! =-----
