1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
|
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Slide2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Const corrAns1 As String = "B"
Const corrAns2 As String = "D"
Const corrAns3 As String = "B"
Const corrAns4 As String = "C"
Const corrAns5 As String = "A"
Const corrAns6 As String = "D"
Const corrAns7 As String = "D"
Const corrAns8 As String = "C"
Const corrAns9 As String = "A"
Const corrAns10 As String = "A"
Const corrAns11 As String = "D"
Const corrAns12 As String = "B"
Const corrAns13 As String = "C"
Const corrAns14 As String = "A"
Const corrAns15 As String = "C"
Const red As Long = 16724736
Const orange As Long = 3381759
Const green As Long = 3394611
Const black As Long = 0
Private Sub cmdStartGame_Click()
ResetGame
SlideShowWindows(1).View.Next
End Sub
'Using lifelines
Public Sub UseFiftyFifty()
UseLifeLine "FiftyFifty"
End Sub
Public Sub UsePhoneFriend()
UseLifeLine "PhoneFriend"
End Sub
Public Sub UseAskAudience()
UseLifeLine "AskAudience"
End Sub
Private Sub UseLifeLine(lifeLineName As String)
Slide3.DisabledLifeLine lifeLineName, True
Slide4.DisabledLifeLine lifeLineName, True
Slide5.DisabledLifeLine lifeLineName, True
Slide6.DisabledLifeLine lifeLineName, True
Slide7.DisabledLifeLine lifeLineName, True
Slide8.DisabledLifeLine lifeLineName, True
Slide9.DisabledLifeLine lifeLineName, True
Slide10.DisabledLifeLine lifeLineName, True
Slide11.DisabledLifeLine lifeLineName, True
Slide12.DisabledLifeLine lifeLineName, True
Slide13.DisabledLifeLine lifeLineName, True
Slide14.DisabledLifeLine lifeLineName, True
Slide15.DisabledLifeLine lifeLineName, True
Slide16.DisabledLifeLine lifeLineName, True
Slide17.DisabledLifeLine lifeLineName, True
End Sub
'Getting values
Public Function GetCorrAnswer(questionIndex As Integer) As String
Select Case questionIndex
Case 1: GetCorrAnswer = corrAns1
Case 2: GetCorrAnswer = corrAns2
Case 3: GetCorrAnswer = corrAns3
Case 4: GetCorrAnswer = corrAns4
Case 5: GetCorrAnswer = corrAns5
Case 6: GetCorrAnswer = corrAns6
Case 7: GetCorrAnswer = corrAns7
Case 8: GetCorrAnswer = corrAns8
Case 9: GetCorrAnswer = corrAns9
Case 10: GetCorrAnswer = corrAns10
Case 11: GetCorrAnswer = corrAns11
Case 12: GetCorrAnswer = corrAns12
Case 13: GetCorrAnswer = corrAns13
Case 14: GetCorrAnswer = corrAns14
Case 15: GetCorrAnswer = corrAns15
End Select
End Function
Private Function GetAnswerIndex(answer As String) As Integer
Select Case answer
Case "A": GetAnswerIndex = 1
Case "B": GetAnswerIndex = 2
Case "C": GetAnswerIndex = 3
Case "D": GetAnswerIndex = 4
End Select
End Function
Public Function GetWrongAnsToKeep(questionI As Integer) As String
Dim keepWrong As Integer
Do
keepWrong = Int((4 * Rnd) + 1)
Loop While keepWrong = GetAnswerIndex(GetCorrAnswer(questionI))
Select Case keepWrong
Case 1: GetWrongAnsToKeep = "A"
Case 2: GetWrongAnsToKeep = "B"
Case 3: GetWrongAnsToKeep = "C"
Case 4: GetWrongAnsToKeep = "D"
End Select
End Function
Public Function GetColor(color As String) As String
Select Case color
Case "Red": GetColor = red
Case "Orange": GetColor = orange
Case "Green": GetColor = green
Case "Black": GetColor = black
End Select
End Function
'Ending Game
Public Sub EndGame(wonMoney As Long)
Slide18.SetPrizeMoney wonMoney
SlideShowWindows(1).View.GotoSlide 18
End Sub
Public Sub ResetGame()
Slide3.Reset
Slide4.Reset
Slide5.Reset
Slide6.Reset
Slide7.Reset
Slide8.Reset
Slide9.Reset
Slide10.Reset
Slide11.Reset
Slide12.Reset
Slide13.Reset
Slide14.Reset
Slide15.Reset
Slide16.Reset
Slide17.Reset
Slide18.SetPrizeMoney 0
End Sub
'Kamen Mladenov 2019
|
