diff options
7 files changed, 631 insertions, 0 deletions
diff --git a/Who wants to become a millionare - Africa (BG)/Extracted code/README.md b/Who wants to become a millionare - Africa (BG)/Extracted code/README.md new file mode 100644 index 0000000..b817b26 --- /dev/null +++ b/Who wants to become a millionare - Africa (BG)/Extracted code/README.md @@ -0,0 +1,6 @@ +This is the code that operates the whole presentation. I have extracted 4 slides. + + - Slide 2: It contains methods that operate on all slides and information like correct answers. It serves as a connection between everything. + - Slide 3: It contains the main code that is used by most slides (slide 3 to 17). It changes button colors, button avalability, has logic for lifelines, etc. It has the code that does the hevy lifting. Slides 3 to 17 have the same code with certain changed values. + - Slide 17: This is the slide with the last question. The only difference to the other slides with questions is when you win (rather than going to next slide it ends the game; Line 96) + - Slide 18: This is the last slide of the presentation. This is where you end up after ending a game (loosing, keeping money or winning). It is nothing special, just descided to include it because it is different.
\ No newline at end of file diff --git a/Who wants to become a millionare - Africa (BG)/Extracted code/Slide17.cls b/Who wants to become a millionare - Africa (BG)/Extracted code/Slide17.cls new file mode 100644 index 0000000..10ca09c --- /dev/null +++ b/Who wants to become a millionare - Africa (BG)/Extracted code/Slide17.cls @@ -0,0 +1,213 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "Slide17" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = True + +Dim correctAns As Boolean +Const currQuestion As Integer = 15 + +'Button_Click events + +Private Sub cmdAnswerA_Click() + +If Not (lblSureAbtAns.Visible) Then + Mark "A" +Else + Finalize "A" +End If + +End Sub + +Private Sub cmdAnswerB_Click() + +If Not (lblSureAbtAns.Visible) Then + Mark "B" +Else + Finalize "B" +End If + +End Sub + +Private Sub cmdAnswerC_Click() + +If Not (lblSureAbtAns.Visible) Then + Mark "C" +Else + Finalize "C" +End If + +End Sub + +Private Sub cmdAnswerD_Click() + +If Not (lblSureAbtAns.Visible) Then + Mark "D" +Else + Finalize "D" +End If + +End Sub + +Private Sub cmdFiftyFifty_Click() + +Slide2.UseFiftyFifty + +Dim keepWrong As String, currCorrect As String +keepWrong = Slide2.GetWrongAnsToKeep(currQuestion) +currCorrect = Slide2.GetCorrAnswer(currQuestion) + +EnableAnswer "All", False +EnableAnswer keepWrong, True +EnableAnswer currCorrect, True + +End Sub + + +Private Sub cmdGiveUp_Click() + +Slide2.EndGame 500000 + +End Sub + +Private Sub cmdPhoneFriend_Click() + +Slide2.UsePhoneFriend +imgFriendMsg.Visible = False + +End Sub + +Private Sub cmdAskAudience_Click() + +Slide2.UseAskAudience +imgAskAudience.Visible = False + +End Sub + +Private Sub cmdContinue_Click() + +If Not (correctAns) Then +Slide2.EndGame 50000 +Else +Slide2.EndGame 1000000 +End If + +End Sub + +' Chosing answers + +Private Sub Mark(chosenAnswer As String) + +ColorAnswer chosenAnswer, "Orange" +DisabledAllLifeLines True +cmdGiveUp.Enabled = False + +lblSureAbtAns.Visible = True + +End Sub + +Private Sub Finalize(chosenAnswer As String) + +If cmdAnswerA.BackColor <> 0 Or cmdAnswerB.BackColor <> 0 Or cmdAnswerC.BackColor <> 0 Or cmdAnswerD.BackColor <> 0 Then + ColorAllAnswers "Black" + ColorAnswer chosenAnswer, "Orange" +End If +ColorAnswer Slide2.GetCorrAnswer(currQuestion), "Green" + +EnableAnswer "All", False +lblSureAbtAns.Visible = False + +If chosenAnswer = Slide2.GetCorrAnswer(currQuestion) Then + correctAns = True +End If + +cmdContinue.Visible = True + 'reloads current slide, continue button can't be pressed sometimes (bug) when made visible +Application.SlideShowWindows(1).View.GotoSlide Me.SlideIndex +End Sub + +'Changing answer properties + +Private Sub ColorAnswer(answer As String, colorName As String) + +Select Case answer + Case "A": cmdAnswerA.BackColor = Slide2.GetColor(colorName) + Case "B": cmdAnswerB.BackColor = Slide2.GetColor(colorName) + Case "C": cmdAnswerC.BackColor = Slide2.GetColor(colorName) + Case "D": cmdAnswerD.BackColor = Slide2.GetColor(colorName) +End Select + +End Sub + +Private Sub ColorAllAnswers(colorName As String) + +ColorAnswer "A", colorName +ColorAnswer "B", colorName +ColorAnswer "C", colorName +ColorAnswer "D", colorName + +End Sub + +Private Sub EnableAnswer(answer As String, isEnabled As Boolean) + +Select Case answer + Case "A": cmdAnswerA.Enabled = isEnabled + Case "B": cmdAnswerB.Enabled = isEnabled + Case "C": cmdAnswerC.Enabled = isEnabled + Case "D": cmdAnswerD.Enabled = isEnabled + Case "All": + EnableAnswer "A", isEnabled + EnableAnswer "B", isEnabled + EnableAnswer "C", isEnabled + EnableAnswer "D", isEnabled +End Select + +End Sub + +'Public methods + +Public Sub DisabledLifeLine(lifeLineName As String, isDisabled As Boolean) + +Select Case lifeLineName + Case "FiftyFifty": cmdFiftyFifty.Enabled = Not (isDisabled) + Case "PhoneFriend": cmdPhoneFriend.Enabled = Not (isDisabled) + Case "AskAudience": cmdAskAudience.Enabled = Not (isDisabled) +End Select + +End Sub + +Public Sub DisabledAllLifeLines(areDisabled As Boolean) + + +DisabledLifeLine "FiftyFifty", areDisabled +DisabledLifeLine "PhoneFriend", areDisabled +DisabledLifeLine "AskAudience", areDisabled + +End Sub + +Public Sub Reset() + +correctAns = False + +DisabledAllLifeLines False +cmdGiveUp.Enabled = True +EnableAnswer "All", True + +ColorAllAnswers "Black" + +cmdContinue.Visible = False +imgFriendMsg.Visible = True +imgAskAudience.Visible = True + +End Sub + +Public Property Get GuessedCorrectly() + GuessedCorrectly = correctAns +End Property + +'Kamen Mladenov 2019 + diff --git a/Who wants to become a millionare - Africa (BG)/Extracted code/Slide18.cls b/Who wants to become a millionare - Africa (BG)/Extracted code/Slide18.cls new file mode 100644 index 0000000..8cc25d1 --- /dev/null +++ b/Who wants to become a millionare - Africa (BG)/Extracted code/Slide18.cls @@ -0,0 +1,22 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "Slide18" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = True +Public Sub SetPrizeMoney(value As Long) + +lblPrize.Caption = value + +End Sub + +Private Sub cmdPlayAgain_Click() + +SlideShowWindows(1).View.GotoSlide 2 + +End Sub + +'Kamen Mladenov 2019 diff --git a/Who wants to become a millionare - Africa (BG)/Extracted code/Slide2.cls b/Who wants to become a millionare - Africa (BG)/Extracted code/Slide2.cls new file mode 100644 index 0000000..32a5d00 --- /dev/null +++ b/Who wants to become a millionare - Africa (BG)/Extracted code/Slide2.cls @@ -0,0 +1,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 diff --git a/Who wants to become a millionare - Africa (BG)/Extracted code/Slide3.cls b/Who wants to become a millionare - Africa (BG)/Extracted code/Slide3.cls new file mode 100644 index 0000000..1f70d63 --- /dev/null +++ b/Who wants to become a millionare - Africa (BG)/Extracted code/Slide3.cls @@ -0,0 +1,211 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "Slide3" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = True +Dim correctAns As Boolean +Const currQuestion As Integer = 1 + +'Button_Click events + +Private Sub cmdAnswerA_Click() + +If Not (lblSureAbtAns.Visible) Then + Mark "A" +Else + Finalize "A" +End If + +End Sub + +Private Sub cmdAnswerB_Click() + +If Not (lblSureAbtAns.Visible) Then + Mark "B" +Else + Finalize "B" +End If + +End Sub + +Private Sub cmdAnswerC_Click() + +If Not (lblSureAbtAns.Visible) Then + Mark "C" +Else + Finalize "C" +End If + +End Sub + +Private Sub cmdAnswerD_Click() + +If Not (lblSureAbtAns.Visible) Then + Mark "D" +Else + Finalize "D" +End If + +End Sub + +Private Sub cmdFiftyFifty_Click() + +Slide2.UseFiftyFifty + +Dim keepWrong As String, currCorrect As String +keepWrong = Slide2.GetWrongAnsToKeep(currQuestion) +currCorrect = Slide2.GetCorrAnswer(currQuestion) + +EnableAnswer "All", False +EnableAnswer keepWrong, True +EnableAnswer currCorrect, True + +End Sub + + +Private Sub cmdGiveUp_Click() + +Slide2.EndGame 0 + +End Sub + +Private Sub cmdPhoneFriend_Click() + +Slide2.UsePhoneFriend +imgFriendMsg.Visible = False + +End Sub + +Private Sub cmdAskAudience_Click() + +Slide2.UseAskAudience +imgAskAudience.Visible = False + +End Sub + +Private Sub cmdContinue_Click() + +If Not (correctAns) Then +Slide2.EndGame 0 +Else +SlideShowWindows(1).View.Next +End If + +End Sub + +' Chosing answers + +Private Sub Mark(chosenAnswer As String) + +ColorAnswer chosenAnswer, "Orange" +DisabledAllLifeLines True +cmdGiveUp.Enabled = False + +lblSureAbtAns.Visible = True + +End Sub + +Private Sub Finalize(chosenAnswer As String) + +If cmdAnswerA.BackColor <> 0 Or cmdAnswerB.BackColor <> 0 Or cmdAnswerC.BackColor <> 0 Or cmdAnswerD.BackColor <> 0 Then + ColorAllAnswers "Black" + ColorAnswer chosenAnswer, "Orange" +End If +ColorAnswer Slide2.GetCorrAnswer(currQuestion), "Green" + +EnableAnswer "All", False +lblSureAbtAns.Visible = False + +If chosenAnswer = Slide2.GetCorrAnswer(currQuestion) Then + correctAns = True +End If + +cmdContinue.Visible = True + 'reloads current slide, continue button can't be pressed sometimes (bug) when made visible +Application.SlideShowWindows(1).View.GotoSlide Me.SlideIndex +End Sub + +'Changing answer properties + +Private Sub ColorAnswer(answer As String, colorName As String) + +Select Case answer + Case "A": cmdAnswerA.BackColor = Slide2.GetColor(colorName) + Case "B": cmdAnswerB.BackColor = Slide2.GetColor(colorName) + Case "C": cmdAnswerC.BackColor = Slide2.GetColor(colorName) + Case "D": cmdAnswerD.BackColor = Slide2.GetColor(colorName) +End Select + +End Sub + +Private Sub ColorAllAnswers(colorName As String) + +ColorAnswer "A", colorName +ColorAnswer "B", colorName +ColorAnswer "C", colorName +ColorAnswer "D", colorName + +End Sub + +Private Sub EnableAnswer(answer As String, isEnabled As Boolean) + +Select Case answer + Case "A": cmdAnswerA.Enabled = isEnabled + Case "B": cmdAnswerB.Enabled = isEnabled + Case "C": cmdAnswerC.Enabled = isEnabled + Case "D": cmdAnswerD.Enabled = isEnabled + Case "All": + EnableAnswer "A", isEnabled + EnableAnswer "B", isEnabled + EnableAnswer "C", isEnabled + EnableAnswer "D", isEnabled +End Select + +End Sub + +'Public methods + +Public Sub DisabledLifeLine(lifeLineName As String, isDisabled As Boolean) + +Select Case lifeLineName + Case "FiftyFifty": cmdFiftyFifty.Enabled = Not (isDisabled) + Case "PhoneFriend": cmdPhoneFriend.Enabled = Not (isDisabled) + Case "AskAudience": cmdAskAudience.Enabled = Not (isDisabled) +End Select + +End Sub + +Public Sub DisabledAllLifeLines(areDisabled As Boolean) + + +DisabledLifeLine "FiftyFifty", areDisabled +DisabledLifeLine "PhoneFriend", areDisabled +DisabledLifeLine "AskAudience", areDisabled + +End Sub + +Public Sub Reset() + +correctAns = False + +DisabledAllLifeLines False +cmdGiveUp.Enabled = True +EnableAnswer "All", True + +ColorAllAnswers "Black" + +cmdContinue.Visible = False +imgFriendMsg.Visible = True +imgAskAudience.Visible = True + +End Sub + +Public Property Get GuessedCorrectly() + GuessedCorrectly = correctAns +End Property + +'Kamen Mladenov 2019 diff --git a/Who wants to become a millionare - Africa (BG)/README.md b/Who wants to become a millionare - Africa (BG)/README.md new file mode 100644 index 0000000..8a1a935 --- /dev/null +++ b/Who wants to become a millionare - Africa (BG)/README.md @@ -0,0 +1,7 @@ +This is a school project between me (code ; backend) and a class mate (questions, pictures, layout, ... ; frontend). +It is a Bulgarian verson of "Who wants to become a millionare?" made in PowerPoint where all questions are themed around Africa. + +It is by far the worst project I have ever done, because of the buggy envornment that is PowerPoint ActiveX, the trash version of Visual Basic - Visual Basic For Applications and the horrible debugger. +And I am not mentioning the crash that deleted all the code (thankfully I was able to recover some and it wasn't too hard to recover) because a slide bugged out while rendering the buttons ... + +Enjoy the fruits of my painful labor.
\ No newline at end of file diff --git a/Who wants to become a millionare - Africa (BG)/Стани Богат - Африка.pptm b/Who wants to become a millionare - Africa (BG)/Стани Богат - Африка.pptm Binary files differnew file mode 100644 index 0000000..75688a1 --- /dev/null +++ b/Who wants to become a millionare - Africa (BG)/Стани Богат - Африка.pptm |