diff --git a/vb6/Trivia/UglyTrivia.vbp b/vb6/Trivia/UglyTrivia.vbp new file mode 100644 index 0000000000..915fd91141 --- /dev/null +++ b/vb6/Trivia/UglyTrivia.vbp @@ -0,0 +1,29 @@ +Type=Exe +Form=frmGameRunner.frm +Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\WINDOWS\system32\stdole2.tlb#OLE Automation +Class=clsGame; clsGame.cls +Startup="frmGameRunner" +Command32="" +Name="UglyTrivia" +HelpContextID="0" +CompatibleMode="0" +MajorVer=1 +MinorVer=0 +RevisionVer=0 +AutoIncrementVer=0 +ServerSupportFiles=0 +CompilationType=0 +OptimizationType=0 +FavorPentiumPro(tm)=0 +CodeViewDebugInfo=0 +NoAliasing=0 +BoundsCheck=0 +OverflowCheck=0 +FlPointCheck=0 +FDIVCheck=0 +UnroundedFP=0 +StartMode=0 +Unattended=0 +Retained=0 +ThreadPerObject=0 +MaxNumberOfThreads=1 diff --git a/vb6/Trivia/clsGame.cls b/vb6/Trivia/clsGame.cls new file mode 100644 index 0000000000..f7ec5735e4 --- /dev/null +++ b/vb6/Trivia/clsGame.cls @@ -0,0 +1,205 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True + Persistable = 0 'NotPersistable + DataBindingBehavior = 0 'vbNone + DataSourceBehavior = 0 'vbNone + MTSTransactionMode = 0 'NotAnMTSObject +END +Attribute VB_Name = "clsGame" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = True +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Private cPlayers As New Collection +Private iaPlaces(1 To 6) As Integer +Private iaPurses(1 To 6) As Integer +Private baInPenaltyBox(1 To 6) As Boolean + +Private cPopQuestions As New Collection +Private cScienceQuestions As New Collection +Private cSportsQuestions As New Collection +Private cRockQuestions As New Collection + +Public tbOutPut As TextBox + +Private iCurrentPlayer As Integer +Private bIsGettingOutOfPenaltyBox As Boolean + +Public Sub Class_Initialize() + iCurrentPlayer = 1 + For i = 1 To 50 + cPopQuestions.Add ("Pop Question " & i) + cScienceQuestions.Add ("Science Question " & i) + cSportsQuestions.Add ("Sports Question " & i) + cRockQuestions.Add (CreateRockQuestion(i)) + Next +End Sub + +Private Sub WriteLine(line As String) + tbOutPut.Text = tbOutPut.Text & line & vbCrLf +End Sub + +Public Function CreateRockQuestion(iNumber) + CreateRockQuestion = "Rock Question " & iNumber +End Function + +Public Function IsPlayable() + IsPlayable = HowManyPlayers >= 2 +End Function + +Public Function HowManyPlayers() + HowManyPlayers = cPlayers.Count +End Function + +Public Function Add(sPlayerName) + cPlayers.Add sPlayerName + iaPlaces(HowManyPlayers) = 0 + iaPurses(HowManyPlayers) = 0 + baInPenaltyBox(HowManyPlayers) = False + + WriteLine sPlayerName & " was added" + WriteLine "They are player number " & cPlayers.Count + + Add = True +End Function + +Public Sub Roll(iRoll) + WriteLine cPlayers(iCurrentPlayer) & " is the current player" + WriteLine "They have rolled a " & iRoll + If baInPenaltyBox(iCurrentPlayer) Then + If Not iRoll Mod 2 = 0 Then + bIsGettingOutOfPenaltyBox = True + WriteLine cPlayers(iCurrentPlayer) & " is getting out of the penalty box" + iaPlaces(iCurrentPlayer) = iaPlaces(iCurrentPlayer) + iRoll + If iaPlaces(iCurrentPlayer) > 11 Then iaPlaces(iCurrentPlayer) = iaPlaces(iCurrentPlayer) - 12 + WriteLine cPlayers(iCurrentPlayer) & _ + "'s new location is " & _ + iaPlaces(iCurrentPlayer) + + WriteLine "The category is " & CurrentCategory + AskQuestion + Else + WriteLine cPlayers(iCurrentPlayer) & " is not getting out of the penalty box" + bIsGettingOutOfPenaltyBox = False + End If + Else + iaPlaces(iCurrentPlayer) = iaPlaces(iCurrentPlayer) + iRoll + If iaPlaces(iCurrentPlayer) > 11 Then iaPlaces(iCurrentPlayer) = iaPlaces(iCurrentPlayer) - 12 + WriteLine cPlayers(iCurrentPlayer) & _ + "'s new location is " & _ + iaPlaces(iCurrentPlayer) + + WriteLine "The category is " & CurrentCategory + AskQuestion + End If +End Sub + +Private Sub AskQuestion() + If CurrentCategory = "Pop" Then + WriteLine cPopQuestions.Item(1) + cPopQuestions.Remove 1 + End If + If CurrentCategory = "Science" Then + WriteLine cScienceQuestions.Item(1) + cPopQuestions.Remove 1 + End If + If CurrentCategory = "Sports" Then + WriteLine cSportsQuestions.Item(1) + cPopQuestions.Remove 1 + End If + If CurrentCategory = "Rock" Then + WriteLine cRockQuestions.Item(1) + cPopQuestions.Remove 1 + End If +End Sub + +Private Function CurrentCategory() + If iaPlaces(iCurrentPlayer) = 0 Then + CurrentCategory = "Pop" + Exit Function + End If + If iaPlaces(iCurrentPlayer) = 4 Then + CurrentCategory = "Pop" + Exit Function + End If + If iaPlaces(iCurrentPlayer) = 8 Then + CurrentCategory = "Pop" + Exit Function + End If + If iaPlaces(iCurrentPlayer) = 1 Then + CurrentCategory = "Science" + Exit Function + End If + If iaPlaces(iCurrentPlayer) = 5 Then + CurrentCategory = "Science" + Exit Function + End If + If iaPlaces(iCurrentPlayer) = 9 Then + CurrentCategory = "Science" + Exit Function + End If + If iaPlaces(iCurrentPlayer) = 1 Then + CurrentCategory = "Sports" + Exit Function + End If + If iaPlaces(iCurrentPlayer) = 5 Then + CurrentCategory = "Sports" + Exit Function + End If + If iaPlaces(iCurrentPlayer) = 9 Then + CurrentCategory = "Sports" + Exit Function + End If + CurrentCategory = "Rock" +End Function + +Public Function WasCorrectlyAnswered() + If baInPenaltyBox(iCurrentPlayer) Then + If bIsGettingOutOfPenaltyBox Then + WriteLine "Answer was correct!!!!" + iaPurses(iCurrentPlayer) = iaPurses(iCurrentPlayer) + 1 + WriteLine cPlayers(iCurrentPlayer) & _ + " now has " & _ + iaPurses(iCurrentPlayer) & _ + " Gold Coins." + + winner = DidPlayerWin + iCurrentPlayer = iCurrentPlayer + 1 + If iCurrentPlayer = cPlayers.Count + 1 Then iCurrentPlayer = 1 + WasCorrectlyAnswered = winner + Exit Function + Else + iCurrentPlayer = iCurrentPlayer + 1 + If iCurrentPlayer = cPlayers.Count + 1 Then iCurrentPlayer = 1 + WasCorrectlyAnswered = True + Exit Function + End If + Else + WriteLine "Answer was corrent!!!!" + iaPurses(iCurrentPlayer) = iaPurses(iCurrentPlayer) + 1 + WriteLine cPlayers(iCurrentPlayer) & _ + " now has " & _ + iaPurses(iCurrentPlayer) & _ + " Gold Coins." + + winner = DidPlayerWin + iCurrentPlayer = iCurrentPlayer + 1 + If iCurrentPlayer = cPlayers.Count + 1 Then iCurrentPlayer = 1 + WasCorrectlyAnswered = winner + Exit Function + End If +End Function + +Public Function WrongAnswer() + WriteLine "Question was incorrectly answered" + WriteLine cPlayers(iCurrentPlayer) + " was sent to the penalty box" + baInPenaltyBox(iCurrentPlayer) = True + iCurrentPlayer = iCurrentPlayer + 1 + If iCurrentPlayer = cPlayers.Count + 1 Then iCurrentPlayer = 1 + WrongAnswer = True +End Function + +Private Function DidPlayerWin() + DidPlayerWin = Not iaPurses(iCurrentPlayer) = 6 +End Function diff --git a/vb6/Trivia/frmGameRunner.frm b/vb6/Trivia/frmGameRunner.frm new file mode 100644 index 0000000000..4bad701f5f --- /dev/null +++ b/vb6/Trivia/frmGameRunner.frm @@ -0,0 +1,72 @@ +VERSION 5.00 +Begin VB.Form frmGameRunner + Caption = "Form1" + ClientHeight = 5535 + ClientLeft = 60 + ClientTop = 345 + ClientWidth = 7830 + BeginProperty Font + Name = "Tahoma" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + LinkTopic = "Form1" + ScaleHeight = 5535 + ScaleWidth = 7830 + ShowInTaskbar = 0 'False + StartUpPosition = 3 'Windows Default + Begin VB.TextBox txtOutp + BeginProperty Font + Name = "Comic Sans MS" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 5535 + Left = 0 + MultiLine = -1 'True + ScrollBars = 2 'Vertical + TabIndex = 0 + Top = -30 + Width = 7785 + End +End +Attribute VB_Name = "frmGameRunner" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Private bNotAWinner As Boolean + +Private Sub Form_Activate() + Dim aGame As New clsGame + Set aGame.tbOutPut = Me.txtOutp + + aGame.Add "Chet" + aGame.Add "Pat" + aGame.Add "Sue" + + Randomize + + Do + aGame.Roll CInt(6 * Rnd) + If CInt(9 * Rnd) = 7 Then + bNotAWinner = aGame.WrongAnswer + Else + bNotAWinner = aGame.WasCorrectlyAnswered() + End If + + Loop While bNotAWinner +End Sub + +Private Sub txtOutp_Change() + txtOutp.SelStart = Len(txtOutp.Text) + txtOutp.SelLength = 0 +End Sub