Rolling the Dice

The Command Button control's (cmdRollDice) Click() event procedure loads images of dice into the Image controls. The image for each control is selected randomly from one of six choices.

The static integer variable numRolls keeps track of how many times the user has clicked on this button. The variable numRolls is incremented by one each time this procedure executes; however, the user is allowed only two clicks per game. For example, when numRolls reaches a value of two, it resets to zero near the end of the procedure.

The string variables uses imageFile and imagePath to hold the name of the file and path to that file, respectively. The file path is stored in a variable; if it needs to be changed later, only one line of code needs editing. (The syntax used to get the file path string will make more sense after you have read Chapter 5.) When the workbook containing Poker Dice is loaded, Excel keeps track of the file path to the loaded workbook (PokerDice.xls). The line of code that stores the file path in the variable imagePath accesses this information using the Path property of the Workbook object. This will actually prevent a "file not found" error if the workbook is copied to a new location on the same, or another computer. An additional backslash is concatenated onto the string for later use.

The program must select an image of a dice randomly; therefore, I use the Randomize() function to initialize VBA's random number generator. Without any arguments passed to it, Randomizer will use the system clock to set a seed value for random number generation. Without the Randomize() function, the same seed value will be used for random number generation. As a result, the same random number sequence will be reproduced each time the program is run. Obviously, I do not want the same sequence of random numbers for each game; therefore, I have added the Randomizer function to the program.

To load an image, I have written several conditional blocks of code. An If/Then/Else code structure checks the Value property of the Check Box controls. If the value is false, then a randomly-chosen image is loaded into the Image control. If the value is true, then no image is loaded—this is why the Image and Check Box controls are cleared and disabled for the first roll. The random number is converted to an integer with the Int() function. As written, the value of the random number can only fall between 1 and 6. I store the random number in a spreadsheet cell because I will need to access this value in another procedure later in the program in order to check the result of the hand. Alternatively, I could use a set of modulelevel variables to hold the result from the random number generation. The entire path to the desired image file is stored in the string variable imageFile. I used filenames "1.bmp", "2.bmp", etc., for my image files in order to make the string concatenation easy. Finally, the image is loaded into the Image control by passing the file path to the LoadPicture() function. This If/Then/Else block is repeated for each of the five Image controls. (In Chapter 5, you will learn how to loop through a set of objects so that you will not have to write the redundant code I've written here.)

Another If/Then/Else structure is used to test the value of the variable numRolls. After the user has rolled twice, the Command Button controls named cmdRollDice and cmdNewGame are disabled and enabled, respectively. The Check Box and Image controls are enabled with a call to ToggleControls() sub procedure (if it's the user's first roll). If it's the user's second roll, the variable numRolls is reinitialized to zero for the next game.

The sub procedure DisplayResult() is called without passing parameters in order to determine the result of the user's hand. This procedure serves to simplify the program by compartmentalizing the larger problem into smaller and more manageable problems—in this case, scoring the hand.

Private Sub cmdRollDice_Click()

'Use random numbers to select an image of a die for each Image control Static numRolls As Integer Dim imageFile As String Dim imagePath As String

'Set path to image files.

imagePath = Workbooks("PokerDice.xls").Path & "\"

numRolls = numRolls + 1

Randomize 'Seed random number generator

'For each image control, get a random number between 1 and 6. 'Use the random number to load specific dice image.

If ckBoxl.Value = False Then

imageFile = imagePath & Trim(Str(Range("B2").Value)) & ".bmp" imgDicel.Picture = LoadPicture(imageFile) End If

If ckBox2.Value = False Then

imageFile = imagePath & Trim(Str(Range("C2").Value)) & ".bmp" imgDice2.Picture = LoadPicture(imageFile) End If

If ckBox3.Value = False Then

imageFile = imagePath & Trim(Str(Range("D2").Value)) & ".bmp" imgDice3.Picture = LoadPicture(imageFile) End If

If ckBox4.Value = False Then

imageFile = imagePath & Trim(Str(Range("E2").Value)) & ".bmp" imgDice4.Picture = LoadPicture(imageFile) End If

If ckBox5.Value = False Then

imageFile = imagePath & Trim(Str(Range("F2").Value)) & ".bmp" imgDice5.Picture = LoadPicture(imageFile) End If

'Use a static variable to ensure the 'user only gets one draw per game.

If numRolls = 2 Then cmdRollDice.Enabled = False cmdNewGame.Enabled = True numRolls = 0

Else

ToggleControls True End If

DisplayResult 'Call sub to display result of roll. End Sub

Figure 3.12 shows an example of the Poker Dice game board after one roll of the dice. Scoring the Hand

In order to score the user's hand, you first determine the number of dice with the same value (for example, three dice with a value of four and two dice with a value of six), then assign a result to the hand (for example, full house). Because I have not yet covered enough VBA programming structures, the process of evaluating the user's hand is somewhat cumbersome, a bit inefficient, and longer than is otherwise necessary; however, you will see several examples of decision structures and functions in the Poker Dice program. After you have read about VBA's looping structures in Chapters 4 and 5, you can come back to this program and improve it.

The Poker Dice game board after one roll.

The sub procedure DisplayResult() makes several function calls to determine the result of the user's hand. The first series of function calls (GetNumOnes, GetNumTwos, and so on) determine the number of dice with a particular value in the user's hand. These functions do not have any parameters, but they do return integers to a series of variables. These variables are passed to another series of functions (IsNothingOrStraight, IsOnePair, and so on) that score the hand and return a string. This is somewhat inefficient in that all seven function calls are made even if the hand has been properly scored by a previously called function. For example, if the first call to the IsNothingOrStraight() function procedure properly scores the hand, the code in the remaining functions still executes. This is why the variable result is passed to these functions—it must retain its string value if the function does not score the hand. The final result is then written to the merged cells on the game board (cell C12).

Private Sub DisplayResult()

'Evaluate the hand based on the value of the each die. Dim numOnes As Integer Dim numTwos As Integer Dim numThrees As Integer Dim numFours As Integer Dim numFives As Integer Dim numSixes As Integer Dim result As String

'Function calls to determine the number of die displaying each value.

numOnes = GetNumOnes numTwos = GetNumTwos numThrees = GetNumThrees numFours = GetNumFours numFives = GetNumFives numSixes = GetNumSixes

'Call functions for the result of the hand.

result = IsNothingOrStraight(numOnes, numTwos, numThrees, numFours, numFives, numSixes, result) result = IsOnePair(numOnes, numTwos, numThrees, _

numFours, numFives, numSixes, result) result = IsTwoPair(numOnes, numTwos, numThrees, _

numFours, numFives, numSixes, result) result = IsThreeOfAKind(numOnes, numTwos, numThrees, _

numFours, numFives, numSixes, result) result = IsFourOfAKind(numOnes, numTwos, numThrees, _

numFours, numFives, numSixes, result) result = IsFiveOfAKind(numOnes, numTwos, numThrees, _

numFours, numFives, numSixes, result) result = IsFullHouse(numOnes, numTwos, numThrees, _ numFours, numFives, numSixes, result)

Range("C12").Value = result End Sub

The Line continuation (_) character tells VBA that I really want just one line of code, but I need to type it on more than one line in the text editor. Make sure there is a single space between the last character and the underscore before proceeding to the next line.

The function procedures GetNumOnes(), GetNumTwos(), GetNumThrees(), GetNumFours(), GetNumFives(), and GetNumSixes() are called from the DisplayResult() sub procedure and they determine the number of dice with a particular value. These functions use numerous If/Then code structures to check the values of the dice stored in the second row of the spreadsheet (cells B2 through F2). The random number function Rnd() generated these values earlier in the program. A variable is then incremented if its associated value is found in a spreadsheet cell. These functions effectively determine how many dice show the value 1, 2, 3, 4, 5, or 6.

Private Function GetNumOnes() As Integer 'Determine the number of dice displayed with a value of 1 Dim numOnes As Integer

If Range("B2").Value = 1 Then numOnes = numOnes + 1

If Range("C2").Value = 1 Then numOnes = numOnes + 1

If Range("D2").Value = 1 Then numOnes = numOnes + 1

If Range("E2").Value = 1 Then numOnes = numOnes + 1

If Range("F2").Value = 1 Then numOnes = numOnes + 1

GetNumOnes End Function numOnes

Private Function GetNumTwos() As Integer 'Determine the number of dice displayed with a value of 2 Dim numTwos As Integer

If

Range("

B2"

)

. Value =

2 Then

numTwos

= numTwos

+

1

If

Range("

C2"

)

. Value =

2 Then

numTwos

= numTwos

+

1

If

Range("

D2"

)

. Value =

2 Then

numTwos

= numTwos

+

1

If

Range("

E2"

)

. Value =

2 Then

numTwos

= numTwos

+

1

If

Range("

F2"

)

. Value =

2 Then

numTwos

= numTwos

+

1

GetNumTwos

=

numTwos

Private Function GetNumThrees() As Integer 'Determine the number of dice displayed with a value of 3 Dim numThrees As Integer

If Range("F2").Value = 3 GetNumThrees = numThrees End Function

Then numThrees = numThrees + 1

Then numThrees = numThrees + 1

Then numThrees = numThrees + 1

Then numThrees = numThrees + 1

Then numThrees = numThrees + 1

Private Function GetNumFours() As Integer 'Determine the number of dice displayed with a value of 4 Dim numFours As Integer

If Range("F2").Value = 4 GetNumFours = numFours End Function

Then

numFours

= numFours

+

1

Then

numFours

= numFours

+

1

Then

numFours

= numFours

+

1

Then

numFours

= numFours

+

1

Then

numFours

= numFours

+

1

Private Function GetNumFives() As Integer 'Determine the number of dice displayed with a value of 5 Dim numFives As Integer

If Range("B2").Value = 5 Then numFives = numFives + 1 If Range("C2").Value = 5 Then numFives = numFives + 1 If Range("D2").Value = 5 Then numFives = numFives + 1 If Range("E2").Value = 5 Then numFives = numFives + 1 If Range("F2").Value = 5 Then numFives = numFives + 1 GetNumFives = numFives End Function

Private Function GetNumSixes() As Integer 'Determine the number of dice displayed with a value of 6 Dim numSixes As Integer

If Range("B2").Value = 6 Then numSixes = numSixes + 1 If Range("C2").Value = 6 Then numSixes = numSixes + 1 If Range("D2").Value = 6 Then numSixes = numSixes + 1 If Range("E2").Value = 6 Then numSixes = numSixes + 1 If Range("F2").Value = 6 Then numSixes = numSixes + 1 GetNumSixes = numSixes End Function

The function procedures IsNothingOrStraight(), IsOnePair(), IsTwoPair(), IsThreeOfAKind(), IsFourOfAKind(), IsFiveOfAKind(), IsSixOfAKind(),IsFullHouse() are called from the Display Result() sub procedure, and effectively score the hand and return a string result.

Each of these functions tests for a particular score (for example, one pair, two pair, and so on) indicated by the function name. These functions use If/Then/Else structures with numerous conditional statements. I said earlier in the chapter there would be an excessive use of conditionals—at this point, it can't be helped much, but I have used a line continuation character (_) in an effort to make the code easier to read.

Consider the IsNothingOrStraight() function procedure. The six conditionals in the first If/Then/Else structure are all linked with logical And. This means that all conditionals must be true if the block of code within the first If/Then statement is to be executed. If the number of occurrences of each die's value is equal to or less than one, a nested If/Then/Else code structure is then used to determine if the hand is a "6 High Straight", a "6 High", or a "5 High Straight". If one of these conditional statements is true, then the function is assigned the value of one of the aforementioned strings which is returned to the calling procedure. If none of the conditionals are true, the original result is returned. Similar logic applies to the remaining functions and their determination of a score. You should study each function carefully noting the use of logical operators, parentheses, and If/Then/Else code structures.

Parentheses can be used to change the order of operator execution in VBA expressions. For example the conditional statement (5 > 4 Or 6 > 3) And 7 < 3 evaluates to false whereas the expression 5 > 4 Or 6 > 3 And 7 < 3 evaluates to true.

Private Function IsNothingOrStraight(numOnes As Integer, numTwos As Integer, _

numThrees As Integer, numFours As Integer, numFives As Integer, _ numSixes As Integer, result As String) As String

If (numOnes <= 1) And (numTwos <= 1) And (numThrees <= 1) And _ (numFours <= 1) And (numFives <= 1) And (numSixes <= 1) Then If (numSixes = 1) And (numOnes = 0) Then

IsNothingOrStraight = "6 High Straight" ElseIf (numSixes = 1) And (numOnes = 1) Then IsNothingOrStraight = "6 High"

Else

IsNothingOrStraight = "5 High Straight" End If

Else

IsNothingOrStraight = result End If End Function

Private Function IsOnePair(numOnes As Integer, numTwos As Integer, _

numThrees As Integer, numFours As Integer, numFives As Integer, numSixes As Integer, result As String) As String

If (numOnes = 2) And (numTwos <= 1) And (numThrees <= 1) And _ (numFours <= 1) And (numFives <= 1) And (numSixes <= 1) Then

IsOnePair = "

Pair

of Ones"

Else

If (numOnes <

= 1)

And (numTwos =

2) And (numThrees <=

1) And _

(numFours

<= 1

) And (numFives

<=

1) And (numSixes

<= 1) Then

IsOnePair = "

Pair

of Twos"

Else

If (numOnes <

= 1)

And (numTwos <=

1)

And (numThrees =

2) And _

(numFours

<= 1

) And (numFives

<=

1) And (numSixes

<= 1) Then

IsOnePair = "

Pair

of Threes"

Else

If (numOnes <

= 1)

And (numTwos <=

= 1)

And (numThrees <=

1) And _

(numFours

= 2)

And (numFives

<= 1

) And (numSixes <

= 1) Then

IsOnePair = "

Pair

of Fours"

Else

If (numOnes <

= 1)

And (numTwos <=

= 1)

And (numThrees <=

1) And _

(numFours

<= 1

) And (numFives

= 2

) And (numSixes <

= 1) Then

IsOnePair = "

Pair

of Fives"

Else

If (numOnes <

= 1)

And (numTwos <=

= 1)

And (numThrees <=

1) And _

(numFours

<= 1

) And (numFives

<=

1) And (numSixes

= 2) Then

IsOnePair = "

Pair

of Sixes"

IsOnePair = result End If End Function

Private Function IsTwoPair(numOnes As Integer, numTwos As Integer, _

numThrees As Integer, numFours As Integer, numFives As Integer, numSixes As Integer, result As String) As String

(numOnes = 2

And numTwos = 2)

Or

(numOnes =

2 And

numThrees =

2)

Or _

(numOnes =

2 And

numFours =

2)

Or _

(numOnes =

2 And

numFives =

2)

Or _

(numOnes =

2 And

numSixes =

2)

Or _

(numTwos =

2 And

numThrees =

2)

Or _

(numTwos =

2 And

numFours =

2)

Or _

(numTwos =

2 And

numFives =

2)

Or _

(numTwos = 2 And numSixes = 2) Or _ (numThrees = 2 And numFours = 2) Or _ (numThrees = 2 And numFives = 2) Or _ (numThrees = 2 And numSixes = 2) Or _ (numFours = 2 And numFives = 2) Or _ (numFours = 2 And numSixes = 2) Or _ (numFives = 2 And numSixes = 2) Then

IsTwoPair = "Two Pair"

Else

IsTwoPair = result End If

End Function

Private Function IsThreeOfAKind(numOnes numThrees As Integer, numSixes As Integer,

As Integer, numTwos As Integer, _ numFours As Integer, numFives As Integer, result As String) As String

If (numOnes = 3 And numTwos < 2 And numThrees < 2 And numFours < 2 And numFives < 2 And numSixes < 2) Then IsThreeOfAKind = "Three Ones" ElseIf (numOnes < 2 And numTwos = 3 And numThrees < 2 And _ numFours < 2 And numFives < 2 And numSixes < 2) Then IsThreeOfAKind = "Three Twos" ElseIf (numOnes < 2 And numTwos < 2 And numThrees = 3 And _ numFours < 2 And numFives < 2 And numSixes < 2) Then IsThreeOfAKind = "Three Threes" ElseIf (numOnes < 2 And numTwos < 2 And numThrees < 2 And _ numFours = 3 And numFives < 2 And numSixes < 2) Then IsThreeOfAKind = "Three Fours" ElseIf (numOnes < 2 And numTwos < 2 And numThrees < 2 And _ numFours < 2 And numFives = 3 And numSixes < 2) Then IsThreeOfAKind = "Three Fives" ElseIf (numOnes < 2 And numTwos < 2 And numThrees < 2 And _ numFours < 2 And numFives < 2 And numSixes = 3) Then IsThreeOfAKind = "Three Sixes"

Else

IsThreeOfAKind = result End If

End Function

Private Function IsFourOfAKind(numOnes As Integer, numTwos As Integer, _

numThrees As Integer, numFours As Integer, numFives As Integer, numSixes As Integer, result As String) As String

If numOnes = 4 Then

IsFourOfAKind = "Four Ones" ElseIf numTwos = 4 Then

IsFourOfAKind = "Four Twos" ElseIf numThrees = 4 Then

IsFourOfAKind = "Four Threes" ElseIf numFours = 4 Then

IsFourOfAKind = "Four Fours" ElseIf numFives = 4 Then

IsFourOfAKind = "Four Fives" ElseIf numSixes = 4 Then

IsFourOfAKind = "Four Sixes"

Else

IsFourOfAKind = result End If End Function

Private Function IsFiveOfAKind(numOnes As Integer, numTwos As Integer, _

numThrees As Integer, numFours As Integer, numFives As Integer, numSixes As Integer, result As String) As String

If numOnes = 5 Then

IsFiveOfAKind = "Five Ones" ElseIf numTwos = 5 Then

IsFiveOfAKind = "Five Twos" ElseIf numThrees = 5 Then

IsFiveOfAKind = "Five Threes" ElseIf numFours = 5 Then

IsFiveOfAKind = "Five Fours" ElseIf numFives = 5 Then

IsFiveOfAKind = "Five Fives" ElseIf numSixes = 5 Then

IsFiveOfAKind = "Five Sixes"

Else

IsFiveOfAKind = result End If End Function

Private Function IsFullHouse(numOnes As Integer, numTwos As Integer, _

numThrees As Integer, numFours As Integer, numFives As Integer, numSixes As Integer, result As String) As String

If (numOnes = 3 And numTwos = 2) Or (numOnes = 3 And numThrees = 2) Or _ (numOnes = 3 And numFours = 2) Or (numOnes = 3 And numFives = 2) Or _ (numOnes = 3 And numSixes = 2) Or (numTwos = 3 And numOnes = 2) Or _ (numTwos = 3 And numThrees = 2) Or (numTwos = 3 And numFours = 2) Or _ (numTwos = 3 And numFives = 2) Or (numTwos = 3 And numSixes = 2) Or _ (numThrees = 3 And numOnes = 2) Or (numThrees = 3 And numTwos = 2) Or _ (numThrees = 3 And numFours = 2) Or (numThrees = 3 And numFives = 2) Or (numThrees = 3 And numSixes = 2) Or (numFours = 3 And numOnes = 2) Or _ (numFours = 3 And numTwos = 2) Or (numFours = 3 And numThrees = 2) Or _ (numFours = 3 And numFives = 2) Or (numFours = 3 And numSixes = 2) Or _ (numFives = 3 And numOnes = 2) Or (numFives = 3 And numTwos = 2) Or _ (numFives = 3 And numThrees = 2) Or (numFives = 3 And numFours = 2) Or _ (numFives = 3 And numSixes = 2) Or (numSixes = 3 And numOnes = 2) Or _ (numSixes = 3 And numTwos = 2) Or (numSixes = 3 And numThrees = 2) Or _ (numSixes = 3 And numFours = 2) Or (numSixes = 3 And numFives = 2) Then

IsFullHouse = "Full House"

Else

IsFullHouse = result End If End Function

Figure 3.13 shows an example of the Poker Dice game board after two rolls of the dice.

That concludes Poker Dice. It really is a pretty simple program. The difficulty lies in following the logic of the large number of conditions contained in the expressions with the If/Then/Else code structures. Some of the procedures are longer than I normally write them because of the number of conditionals involved and I have not yet discussed loops. As you may have already guessed, these procedures can be simplified significantly with the use of different programming structures and techniques. You will look at a couple of these structures in the next chapter.

The Poker Dice game board after two rolls.

Biorhythm Awareness

Biorhythm Awareness

Who else wants to take advantage of biorhythm awareness to avoid premature death, escape life threatening diseases, eliminate most of your life altering mistakes and banish catastrophic events from your life.

Get My Free Ebook


Post a comment