forked from jbrains/trivia
-
Notifications
You must be signed in to change notification settings - Fork 1
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Albert-Jan Nijburg
committed
Feb 17, 2014
1 parent
fecd35f
commit 7983ec2
Showing
3 changed files
with
306 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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 |