Merge pull request jbrains#23 from Curit/vb6-version

Adds a vb6 version.

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

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

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