ExceLudo
ExcelLudo has 4 players who each have 4 tiles in their camps.
The task is to get all your troops, I mean tiles, out of the Camp, move around clockwise and finish in their Fort where they'll be safe. The rules are:
1. Move your tiles clockwise from the Camp into the Fort.
2. Once in the Fort the tile is safe.
3. To get a tile out of the Camp requires a 6.
4. A 6 entitles you to another throw, or click, of the die in the gold center of the game.
5. You have the option of moving a tile or getting a tile out of your Camp with a 6 except for the first tile.
6. There cannot be 2 tiles on a space.
7. If you've got no move then click on Next Player.
8. Land on an opponents tile and it will be transported back into its Camp.
9. You must throw the right number to occupy an empty spot in the fort.
There are some tactics involved.
If you get a 6 then you decide whether to get another tile out of the camp or whether to advance a tile.
If you can land on an opponent, you can send it back to its camp or advance another tile.
Avoid landing on an opponents entry cell.
Move off your entry cell to enable getting another tile into play.
You can also give up your turn.
Here is a game underway:
The task is to get all your troops, I mean tiles, out of the Camp, move around clockwise and finish in their Fort where they'll be safe. The rules are:
1. Move your tiles clockwise from the Camp into the Fort.
2. Once in the Fort the tile is safe.
3. To get a tile out of the Camp requires a 6.
4. A 6 entitles you to another throw, or click, of the die in the gold center of the game.
5. You have the option of moving a tile or getting a tile out of your Camp with a 6 except for the first tile.
6. There cannot be 2 tiles on a space.
7. If you've got no move then click on Next Player.
8. Land on an opponents tile and it will be transported back into its Camp.
9. You must throw the right number to occupy an empty spot in the fort.
There are some tactics involved.
If you get a 6 then you decide whether to get another tile out of the camp or whether to advance a tile.
If you can land on an opponent, you can send it back to its camp or advance another tile.
Avoid landing on an opponents entry cell.
Move off your entry cell to enable getting another tile into play.
You can also give up your turn.
Here is a game underway:
The blue player has 2 tiles on the move and 1 in its fort and 1 to get out.
The green and orange players have one tile on the move and 1 tile in their forts.
The red player has 1 tile on the move but none in its fort.
The top left purplish path cell is C3.
Lets make a start by adding a Module and declaring some Global variables.
Option Explicit
'This is modVariables
Public blnMoving As Boolean, blnUnsuccessful As Boolean
Public intRowClicked, intColumnClicked As Integer
Public intPlayer As Integer
Public bytPlayerTiles(4) As Byte
Public blnRolling As Boolean
Public blnBusy As Boolean
Public intDie As Integer
Public Const Gold As Integer = 44
As well, there are some cells on the spreadsheet used for variables and constants.
It just happened because it was easier to visualize.
The columns are normally hidden.
The green and orange players have one tile on the move and 1 tile in their forts.
The red player has 1 tile on the move but none in its fort.
The top left purplish path cell is C3.
Lets make a start by adding a Module and declaring some Global variables.
Option Explicit
'This is modVariables
Public blnMoving As Boolean, blnUnsuccessful As Boolean
Public intRowClicked, intColumnClicked As Integer
Public intPlayer As Integer
Public bytPlayerTiles(4) As Byte
Public blnRolling As Boolean
Public blnBusy As Boolean
Public intDie As Integer
Public Const Gold As Integer = 44
As well, there are some cells on the spreadsheet used for variables and constants.
It just happened because it was easier to visualize.
The columns are normally hidden.
This is where the players names can be changed. Store 1 and 2 are used to record the color of the tiles a tile moves over. The color is then reinstated on the grid as the tile moves on.
As well, I have named some cells on the spreadsheet.
The first procedure is to Start the game. Add another module.
I started to name some cells as I'm presenting it here.
Option Explicit
'This is modStart
Sub cmdStart()
Dim b, b2 As Byte
'Stop Worksheet_SelectionChange
blnBusy = True
' Could ask to enter players names
' For intPlayer = 1 To 4
' Cells(7 + intPlayer, 20) = InputBox("Enter player " _
' & intPlayer, "Enter players", Cells(7 + intPlayer, 20))
' Next intPlayer
'Set path to default color
'Name C3:O3 & O4:O15 & C15:N15 & C4:C14 as GamePath
'Name T7 PathColor. I made the ColorIndex 39
[Gamepath].Interior.ColorIndex = [PathColor].Interior.ColorIndex
'Decide player to start.
'Subtract 1 since Sub NextPlayer adds one
Randomize
intPlayer = Int(Rnd() * 4 + 1) - 1
'Players have 4 tiles
For b = 1 To 4
bytPlayerTiles(b) = 4
Next b
'Reset players CAMPs
For b = 1 To 4
PlayersTilesInCamp (b)
Next b
'Reset players FORTs
For b = 1 To 4 'the players
For b2 = 1 To 4 'the tiles
Cells(Cells(7 + b, 26) + Cells(7 + b, 28) * b2, _
Cells(7 + b, 27) + Cells(7 + b, 29) * b2).Interior.Color _
= Cells(7 + b, 21).Interior.Color
Next b2
Next b
'Name H8:J10 Die
[Die].Interior.ColorIndex = Gold
[F11] = ""
NextPlayer
blnBusy = False
End Sub
This calls Sub NextPlayer to give instructions.
I put it into another module to make it easier to find.
Option Explicit
'This is modNextPlayer
Sub NextPlayer()
'Name T14 ActivePlayer
intPlayer = intPlayer + 1
If intPlayer > 4 Then intPlayer = 1
[ActivePlayer] = Cells(7 + intPlayer, 20)
[ActivePlayer].Interior.ColorIndex _
= Cells(7 + intPlayer, 20).Interior.ColorIndex
blnRolling = True
'Name F7 as DisplayAction
[DisplayAction].Font.Color = [ActivePlayer].Interior.Color
[DisplayAction] = [ActivePlayer] & " to click the die"
'Select cell under the blue Rules Rectangle
[I18].Select
End Sub
We now code in the Sheet 1 code sheet. Click on Worksheet in the top left combobox.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim bytLoop As Byte
Static blnStartGame As Boolean
Static blnNextPlayer As Boolean
'Exit if the die is rolling or start of game
If blnBusy Then Exit Sub
If blnStartGame Then
'The player clicked Yes to start a game
If Target.Row = 10 And Target.Column = 4 Then
cmdStart
[D10] = ""
[F10] = ""
blnStartGame = False
Exit Sub
End If
'The player clicked No to start a game
If Target.Row = 10 And Target.Column = 6 Then
[D10] = ""
[F10] = ""
blnStartGame = False
End If
'Waiting for player to click Yes or No to Start a game
If blnStartGame Then
MsgBox "Click Yes or No please."
End If
blnBusy = True
[I18].Select
blnBusy = False
Exit Sub
End If
'The player has clicked 'Start Game'
If Not Intersect(Target, [D9:G9]) Is Nothing Then
[D10] = "Yes"
[F10] = "No"
[I18].Select
blnStartGame = True
Exit Sub
End If
So the player clicks on Start Game and then has to click Yes or No. There is at the moment no check whether someone has got all the troops in their fort.
There is no check whether the player has a possible move. The player clicks on Next Player if no move is possible or wants to forgo the move if you allow it, then has to click Yes or No.
If blnNextPlayer Then
If Target.Row = 10 And Target.Column = 13 Then
[M10] = ""
[K10] = ""
blnNextPlayer = False
End If
If Target.Row = 10 And Target.Column = 11 Then
[M10] = ""
[K10] = ""
NextPlayer
blnNextPlayer = False
End If
[I18].Select
Exit Sub
End If
'The player has clicked 'Next Player'
If Not Intersect(Target, [K9:N9]) Is Nothing Then
'If Target.Row = 9 And Target.Column = 11 Then
[K10] = "Yes"
[M10] = "No"
blnNextPlayer = True
Exit Sub
End If
If blnNextPlayer Then
If Target.Row = 10 And Target.Column = 13 Then
[M10] = ""
[K10] = ""
blnNextPlayer = False
End If
If Target.Row = 10 And Target.Column = 11 Then
[M10] = ""
[K10] = ""
NextPlayer
blnNextPlayer = False
End If
[I18].Select
Exit Sub
End If
'The player has clicked 'Next Player'
If Not Intersect(Target, [K9:N9]) Is Nothing Then
'If Target.Row = 9 And Target.Column = 11 Then
[K10] = "Yes"
[M10] = "No"
blnNextPlayer = True
Exit Sub
End If
'Check if the player is to roll the die
If blnRolling Then
'Exit if die not clicked
If Intersect(Target, [Die]) Is Nothing Then
[F7].Select
Exit Sub
End If
[F11:F12] = ""
RollTheDie
'More to come
This is calling the RollTheDie procedure so I better give that next. I put into yet another Module.
Option Explicit
'This is modRollTheDie
Sub RollTheDie()
'Stop WorkSheet_SelectionChange procedure in its track
blnBusy = True
'Clear the die
[Die].Interior.ColorIndex = Gold
Randomize
intDie = Int(Rnd() * 6) + 1
Select Case intDie
Case 1
[I9].Interior.Color = vbBlack
Case 2
[H10,J8].Interior.Color = vbBlack
Case 3
[H10,I9,J8].Interior.Color = vbBlack
Case 4
[H8,J8,J10,H10].Interior.Color = vbBlack
Case 5
[H8,J8,J10,H10,I9].Interior.Color = vbBlack
Case 6
[H8,I8,J8,H10,I10,J10].Interior.Color = vbBlack
End Select
[F7] = [T14] & " to move a tile"
[I18].Select
blnRolling = False
blnBusy = False
End Sub
Back to the Selection_Change procedure.
'If a 6 and 1st tile then bring out a tile
If intDie = 6 And bytPlayerTiles(intPlayer) = 4 Then
'Check the colour of the cell in front of the CAMP
For bytLoop = 1 To 4
If Cells(Cells(7 + intPlayer, 24), _
Cells(7 + intPlayer, 25)).Interior.ColorIndex _
= Cells(7 + bytLoop, 20).Interior.ColorIndex Then
'It's another player there so return their tile to their camp
[F12].Font.Color = Cells(7 + bytLoop, 20).Interior.Color
[F12] = "Returning " & Cells(7 + bytLoop, 20) & " tile."
'Adjust tiles for that player
bytPlayerTiles(bytLoop) = bytPlayerTiles(bytLoop) + 1
PlayersTilesInCamp (bytLoop)
End If
Next bytLoop
'Bring out the tile
Cells(Cells(7 + intPlayer, 24), _
Cells(7 + intPlayer, 25)).Interior.ColorIndex _
= [T14].Interior.ColorIndex
bytPlayerTiles(intPlayer) = 3
PlayersTilesInCamp (intPlayer)
[F11].Font.Color = [T14].Interior.Color
[F11] = "A Tile has entered!"
[F7] = [T14] & " to click the die."
blnRolling = True
Exit Sub
End If
'Here is More
'Exit if no tiles yet and no 6
If intDie <> 6 And bytPlayerTiles(intPlayer) = 4 Then
[F11].Font.Color = [T14].Interior.Color
[F11] = "No move possible."
NextPlayer
Exit Sub
End If
End If
'Not rolling, must be moving a tile
'Exit if we're not in the playing area
If Target.Row < 3 Or Target.Row > 15 _
Or Target.Column < 3 Or Target.Column > 15 Then _
[I18].Select: Exit Sub
'Exit if the players tile is not clicked
If Cells(Target.Row, Target.Column).Interior.ColorIndex _
<> [T14].Interior.ColorIndex Then _
[I18].Select: Exit Sub
'Exit if clicked on CAMP tile without a six rolled
If intDie <> 6 And (Target = "C" Or Target = "A" _
Or Target = "M" Or Target = "P") Then
[F11].Font.Color = [T14].Interior.Color
[F11] = "Not without a 6!"
[I18].Select
Exit Sub
End If
'Move CAMP tile if a 6 and a tile is left and clicked on CAMP
If intDie = 6 And bytPlayerTiles(intPlayer) > 0 Then
If (Target = "C" Or Target = "A" Or Target = "M" Or Target = "P") Then
'but not if a CAMP tile is sitting just outside CAMP
If Cells(Cells(7 + intPlayer, 24), _
Cells(7 + intPlayer, 25)).Interior.ColorIndex _
= [T14].Interior.ColorIndex Then
[F11].Font.Color = [T14].Interior.Color
[F11] = "Your own tile is there!"
[I18].Select
Exit Sub
End If
'Check for someone else's tile
For bytLoop = 1 To 4
If Cells(Cells(7 + intPlayer, 24), Cells(7 + intPlayer, 25)).Interior.ColorIndex _
= Cells(7 + bytLoop, 20).Interior.ColorIndex Then
'There is one!
[F12].Font.Color = Cells(7 + bytLoop, 20).Interior.Color
[F12] = "Returning " & Cells(7 + bytLoop, 20) & " tile!"
'Adjust tiles for a player hit
bytPlayerTiles(bytLoop) = bytPlayerTiles(bytLoop) + 1
PlayersTilesInCamp (bytLoop)
End If
Next bytLoop
'Now put the players tile there
Cells(Cells(7 + intPlayer, 24), _
Cells(7 + intPlayer, 25)).Interior.ColorIndex _
= [T14].Interior.ColorIndex
bytPlayerTiles(intPlayer) = bytPlayerTiles(intPlayer) - 1
'Adjust tiles in CAMP
PlayersTilesInCamp (intPlayer)
blnRolling = True
[F11].Font.Color = [T14].Interior.Color
[F11] = "Roll again after the 6. "
[F7] = [T14] & " to click the die."
[I18].Select
Exit Sub
End If
End If
'If clicked on player tile then move the tile
Call PlayerMove(Target.Row, Target.Column)
If blnUnsuccessful Then [I18].Select: Exit Sub
If intDie = 6 Then
blnRolling = True
[F11].Font.Color = [T14].Interior.Color
[F11] = "Roll again after the 6. "
[F7] = [T14] & " to click the die."
Else
NextPlayer
End If
End Sub
That's a big sub!
Which brings us to the PlayerMove procedure.
It has to move around corners! It therefore is another long procedure.
Sub PlayerMove(intRow As Integer, intColumn As Integer)
'This is modPlayerMove
Dim intMoves As Integer, intLoop As Integer
Dim intOldRow As Integer, intOldColumn As Integer
Dim intRowMove As Integer, intColumnMove As Integer
'Dim iTempRow, iTempCol As Integer
'Dim i1, i2, i3, i4 As Integer
'Store original tile position
intOldRow = intRow
intOldColumn = intColumn
blnUnsuccessful = False
'Set Store 1 to default color, see range Stores
Cells(13, 23).Interior.ColorIndex _
= Cells(13, 20).Interior.ColorIndex
For intMoves = 1 To intDie
'Change direction when coming to a corner
'Bottom right corner
If intColumn = 15 And intRow < 15 Then
intRowMove = 1
intColumnMove = 0
End If
'Bottom left corner
If intRow = 15 And intColumn > 3 Then
intRowMove = 0
intColumnMove = -1
End If
'Top left corner
If intColumn = 3 And intRow > 3 Then
intRowMove = -1
intColumnMove = 0
End If
'Top right corner
If intRow = 3 And intColumn < 15 Then
intRowMove = 0
intColumnMove = 1
End If
'Is the tile heading into the FORT?
For intLoop = 0 To 3
If intRow = Cells(7 + intPlayer, 26) + intLoop * Cells(7 + intPlayer, 28) Then
If intColumn = Cells(7 + intPlayer, 27) + intLoop * Cells(7 + intPlayer, 29) Then
intRowMove = Cells(7 + intPlayer, 28)
intColumnMove = Cells(7 + intPlayer, 29)
End If
End If
Next intLoop
'Keep track of tiles traversed
'Copy Store 1 to Store 2
Cells(13, 24).Interior.ColorIndex _
= Cells(13, 23).Interior.ColorIndex
'Copy Store 2 to Current Cell
Cells(intRow, intColumn).Interior.ColorIndex _
= Cells(13, 24).Interior.ColorIndex
'Copy Next Cell to Store 1
Cells(13, 23).Interior.ColorIndex _
= Cells((intRow + intRowMove), _
(intColumn + intColumnMove)).Interior.ColorIndex
'If the tile is moving too far into the fort
If Cells(13, 23).Interior.ColorIndex = Cells(7, 9).Interior.ColorIndex Then
'return the tile to the original spot
Cells(intOldRow, intOldColumn).Interior.ColorIndex _
= Cells(7 + intPlayer, 20).Interior.ColorIndex
[F11].Font.Color = [T14].Interior.Color
[F11] = "Too far into the Fort."
blnUnsuccessful = True
Exit Sub
End If
'Place player in Next Cell
Cells((intRow + intRowMove), _
(intColumn + intColumnMove)).Interior.ColorIndex _
= Cells(7 + intPlayer, 20).Interior.ColorIndex
'Advance to next cell if more intMoves
intRow = intRow + intRowMove
intColumn = intColumn + intColumnMove
Next intMoves
'Check what's in this space
'If it's not the default colour
If Cells(13, 23).Interior.ColorIndex <> Cells(7, 20).Interior.ColorIndex Then
'Is it the players own tile?
If Cells(13, 23).Interior.ColorIndex = Cells(7 + intPlayer, 20).Interior.ColorIndex _
Or Cells(13, 23).Interior.ColorIndex = Cells(7, 9).Interior.ColorIndex Then
'Then move the player back to the original spot
Cells(intOldRow, intOldColumn).Interior.ColorIndex _
= Cells(7 + intPlayer, 20).Interior.ColorIndex
[F12] = "You have a tile there!"
Cells((intRow), (intColumn)).Interior.ColorIndex _
= Cells(13, 23).Interior.ColorIndex
blnUnsuccessful = True
Exit Sub
Else
'If a tile already in the FORT is moved
'then colour the old cell the players empty colour
If Cells(intOldRow, intOldColumn) = "F" _
Or Cells(intOldRow, intOldColumn) = "O" _
Or Cells(intOldRow, intOldColumn) = "R" _
Or Cells(intOldRow, intOldColumn) = "T" Then
Cells(intOldRow, intOldColumn).Interior.ColorIndex _
= Cells(7 + intPlayer, 21).Interior.ColorIndex
End If
'Check the colour of the tile hit
For intLoop = 1 To 4
If Cells(13, 23).Interior.ColorIndex _
= Cells(7 + intLoop, 20).Interior.ColorIndex Then
If intDie = 6 Then
[F12].Font.Color = Cells(7 + intLoop, 20).Interior.Color
[F12] = "Returning " & Cells(7 + intLoop, 20) & " tile!"
Else
[F11].Font.Color = Cells(7 + intLoop, 20).Interior.Color
[F11] = "Returning " & Cells(7 + intLoop, 20) & " tile!"
End If
'Send opponent tile back to its CAMP
bytPlayerTiles(intLoop) = bytPlayerTiles(intLoop) + 1
PlayersTilesInCamp (intLoop)
End If
Next intLoop
End If
End If
End Sub
Here is an important procedure.
Sub PlayersTilesInCamp(iPlayer As Integer)
Dim b As Byte
'Color the tiles in a players camp
For b = 1 To 4
'Color them all the players color first
Cells(Cells(7 + iPlayer, 24) + Cells(7 + iPlayer, 28) * b, _
Cells(7 + iPlayer, 25) + Cells(7 + iPlayer, 29) * b).Interior.Color _
= Cells(7 + iPlayer, 20).Interior.Color
If bytPlayerTiles(iPlayer) < b Then
'Color them as empty if they are out and about
Cells(Cells(7 + iPlayer, 24) + Cells(7 + iPlayer, 28) * b, _
Cells(7 + iPlayer, 25) + Cells(7 + iPlayer, 29) * b).Interior.Color _
= Cells(7 + iPlayer, 21).Interior.Color
End If
Next b
End Sub
If blnRolling Then
'Exit if die not clicked
If Intersect(Target, [Die]) Is Nothing Then
[F7].Select
Exit Sub
End If
[F11:F12] = ""
RollTheDie
'More to come
This is calling the RollTheDie procedure so I better give that next. I put into yet another Module.
Option Explicit
'This is modRollTheDie
Sub RollTheDie()
'Stop WorkSheet_SelectionChange procedure in its track
blnBusy = True
'Clear the die
[Die].Interior.ColorIndex = Gold
Randomize
intDie = Int(Rnd() * 6) + 1
Select Case intDie
Case 1
[I9].Interior.Color = vbBlack
Case 2
[H10,J8].Interior.Color = vbBlack
Case 3
[H10,I9,J8].Interior.Color = vbBlack
Case 4
[H8,J8,J10,H10].Interior.Color = vbBlack
Case 5
[H8,J8,J10,H10,I9].Interior.Color = vbBlack
Case 6
[H8,I8,J8,H10,I10,J10].Interior.Color = vbBlack
End Select
[F7] = [T14] & " to move a tile"
[I18].Select
blnRolling = False
blnBusy = False
End Sub
Back to the Selection_Change procedure.
'If a 6 and 1st tile then bring out a tile
If intDie = 6 And bytPlayerTiles(intPlayer) = 4 Then
'Check the colour of the cell in front of the CAMP
For bytLoop = 1 To 4
If Cells(Cells(7 + intPlayer, 24), _
Cells(7 + intPlayer, 25)).Interior.ColorIndex _
= Cells(7 + bytLoop, 20).Interior.ColorIndex Then
'It's another player there so return their tile to their camp
[F12].Font.Color = Cells(7 + bytLoop, 20).Interior.Color
[F12] = "Returning " & Cells(7 + bytLoop, 20) & " tile."
'Adjust tiles for that player
bytPlayerTiles(bytLoop) = bytPlayerTiles(bytLoop) + 1
PlayersTilesInCamp (bytLoop)
End If
Next bytLoop
'Bring out the tile
Cells(Cells(7 + intPlayer, 24), _
Cells(7 + intPlayer, 25)).Interior.ColorIndex _
= [T14].Interior.ColorIndex
bytPlayerTiles(intPlayer) = 3
PlayersTilesInCamp (intPlayer)
[F11].Font.Color = [T14].Interior.Color
[F11] = "A Tile has entered!"
[F7] = [T14] & " to click the die."
blnRolling = True
Exit Sub
End If
'Here is More
'Exit if no tiles yet and no 6
If intDie <> 6 And bytPlayerTiles(intPlayer) = 4 Then
[F11].Font.Color = [T14].Interior.Color
[F11] = "No move possible."
NextPlayer
Exit Sub
End If
End If
'Not rolling, must be moving a tile
'Exit if we're not in the playing area
If Target.Row < 3 Or Target.Row > 15 _
Or Target.Column < 3 Or Target.Column > 15 Then _
[I18].Select: Exit Sub
'Exit if the players tile is not clicked
If Cells(Target.Row, Target.Column).Interior.ColorIndex _
<> [T14].Interior.ColorIndex Then _
[I18].Select: Exit Sub
'Exit if clicked on CAMP tile without a six rolled
If intDie <> 6 And (Target = "C" Or Target = "A" _
Or Target = "M" Or Target = "P") Then
[F11].Font.Color = [T14].Interior.Color
[F11] = "Not without a 6!"
[I18].Select
Exit Sub
End If
'Move CAMP tile if a 6 and a tile is left and clicked on CAMP
If intDie = 6 And bytPlayerTiles(intPlayer) > 0 Then
If (Target = "C" Or Target = "A" Or Target = "M" Or Target = "P") Then
'but not if a CAMP tile is sitting just outside CAMP
If Cells(Cells(7 + intPlayer, 24), _
Cells(7 + intPlayer, 25)).Interior.ColorIndex _
= [T14].Interior.ColorIndex Then
[F11].Font.Color = [T14].Interior.Color
[F11] = "Your own tile is there!"
[I18].Select
Exit Sub
End If
'Check for someone else's tile
For bytLoop = 1 To 4
If Cells(Cells(7 + intPlayer, 24), Cells(7 + intPlayer, 25)).Interior.ColorIndex _
= Cells(7 + bytLoop, 20).Interior.ColorIndex Then
'There is one!
[F12].Font.Color = Cells(7 + bytLoop, 20).Interior.Color
[F12] = "Returning " & Cells(7 + bytLoop, 20) & " tile!"
'Adjust tiles for a player hit
bytPlayerTiles(bytLoop) = bytPlayerTiles(bytLoop) + 1
PlayersTilesInCamp (bytLoop)
End If
Next bytLoop
'Now put the players tile there
Cells(Cells(7 + intPlayer, 24), _
Cells(7 + intPlayer, 25)).Interior.ColorIndex _
= [T14].Interior.ColorIndex
bytPlayerTiles(intPlayer) = bytPlayerTiles(intPlayer) - 1
'Adjust tiles in CAMP
PlayersTilesInCamp (intPlayer)
blnRolling = True
[F11].Font.Color = [T14].Interior.Color
[F11] = "Roll again after the 6. "
[F7] = [T14] & " to click the die."
[I18].Select
Exit Sub
End If
End If
'If clicked on player tile then move the tile
Call PlayerMove(Target.Row, Target.Column)
If blnUnsuccessful Then [I18].Select: Exit Sub
If intDie = 6 Then
blnRolling = True
[F11].Font.Color = [T14].Interior.Color
[F11] = "Roll again after the 6. "
[F7] = [T14] & " to click the die."
Else
NextPlayer
End If
End Sub
That's a big sub!
Which brings us to the PlayerMove procedure.
It has to move around corners! It therefore is another long procedure.
Sub PlayerMove(intRow As Integer, intColumn As Integer)
'This is modPlayerMove
Dim intMoves As Integer, intLoop As Integer
Dim intOldRow As Integer, intOldColumn As Integer
Dim intRowMove As Integer, intColumnMove As Integer
'Dim iTempRow, iTempCol As Integer
'Dim i1, i2, i3, i4 As Integer
'Store original tile position
intOldRow = intRow
intOldColumn = intColumn
blnUnsuccessful = False
'Set Store 1 to default color, see range Stores
Cells(13, 23).Interior.ColorIndex _
= Cells(13, 20).Interior.ColorIndex
For intMoves = 1 To intDie
'Change direction when coming to a corner
'Bottom right corner
If intColumn = 15 And intRow < 15 Then
intRowMove = 1
intColumnMove = 0
End If
'Bottom left corner
If intRow = 15 And intColumn > 3 Then
intRowMove = 0
intColumnMove = -1
End If
'Top left corner
If intColumn = 3 And intRow > 3 Then
intRowMove = -1
intColumnMove = 0
End If
'Top right corner
If intRow = 3 And intColumn < 15 Then
intRowMove = 0
intColumnMove = 1
End If
'Is the tile heading into the FORT?
For intLoop = 0 To 3
If intRow = Cells(7 + intPlayer, 26) + intLoop * Cells(7 + intPlayer, 28) Then
If intColumn = Cells(7 + intPlayer, 27) + intLoop * Cells(7 + intPlayer, 29) Then
intRowMove = Cells(7 + intPlayer, 28)
intColumnMove = Cells(7 + intPlayer, 29)
End If
End If
Next intLoop
'Keep track of tiles traversed
'Copy Store 1 to Store 2
Cells(13, 24).Interior.ColorIndex _
= Cells(13, 23).Interior.ColorIndex
'Copy Store 2 to Current Cell
Cells(intRow, intColumn).Interior.ColorIndex _
= Cells(13, 24).Interior.ColorIndex
'Copy Next Cell to Store 1
Cells(13, 23).Interior.ColorIndex _
= Cells((intRow + intRowMove), _
(intColumn + intColumnMove)).Interior.ColorIndex
'If the tile is moving too far into the fort
If Cells(13, 23).Interior.ColorIndex = Cells(7, 9).Interior.ColorIndex Then
'return the tile to the original spot
Cells(intOldRow, intOldColumn).Interior.ColorIndex _
= Cells(7 + intPlayer, 20).Interior.ColorIndex
[F11].Font.Color = [T14].Interior.Color
[F11] = "Too far into the Fort."
blnUnsuccessful = True
Exit Sub
End If
'Place player in Next Cell
Cells((intRow + intRowMove), _
(intColumn + intColumnMove)).Interior.ColorIndex _
= Cells(7 + intPlayer, 20).Interior.ColorIndex
'Advance to next cell if more intMoves
intRow = intRow + intRowMove
intColumn = intColumn + intColumnMove
Next intMoves
'Check what's in this space
'If it's not the default colour
If Cells(13, 23).Interior.ColorIndex <> Cells(7, 20).Interior.ColorIndex Then
'Is it the players own tile?
If Cells(13, 23).Interior.ColorIndex = Cells(7 + intPlayer, 20).Interior.ColorIndex _
Or Cells(13, 23).Interior.ColorIndex = Cells(7, 9).Interior.ColorIndex Then
'Then move the player back to the original spot
Cells(intOldRow, intOldColumn).Interior.ColorIndex _
= Cells(7 + intPlayer, 20).Interior.ColorIndex
[F12] = "You have a tile there!"
Cells((intRow), (intColumn)).Interior.ColorIndex _
= Cells(13, 23).Interior.ColorIndex
blnUnsuccessful = True
Exit Sub
Else
'If a tile already in the FORT is moved
'then colour the old cell the players empty colour
If Cells(intOldRow, intOldColumn) = "F" _
Or Cells(intOldRow, intOldColumn) = "O" _
Or Cells(intOldRow, intOldColumn) = "R" _
Or Cells(intOldRow, intOldColumn) = "T" Then
Cells(intOldRow, intOldColumn).Interior.ColorIndex _
= Cells(7 + intPlayer, 21).Interior.ColorIndex
End If
'Check the colour of the tile hit
For intLoop = 1 To 4
If Cells(13, 23).Interior.ColorIndex _
= Cells(7 + intLoop, 20).Interior.ColorIndex Then
If intDie = 6 Then
[F12].Font.Color = Cells(7 + intLoop, 20).Interior.Color
[F12] = "Returning " & Cells(7 + intLoop, 20) & " tile!"
Else
[F11].Font.Color = Cells(7 + intLoop, 20).Interior.Color
[F11] = "Returning " & Cells(7 + intLoop, 20) & " tile!"
End If
'Send opponent tile back to its CAMP
bytPlayerTiles(intLoop) = bytPlayerTiles(intLoop) + 1
PlayersTilesInCamp (intLoop)
End If
Next intLoop
End If
End If
End Sub
Here is an important procedure.
Sub PlayersTilesInCamp(iPlayer As Integer)
Dim b As Byte
'Color the tiles in a players camp
For b = 1 To 4
'Color them all the players color first
Cells(Cells(7 + iPlayer, 24) + Cells(7 + iPlayer, 28) * b, _
Cells(7 + iPlayer, 25) + Cells(7 + iPlayer, 29) * b).Interior.Color _
= Cells(7 + iPlayer, 20).Interior.Color
If bytPlayerTiles(iPlayer) < b Then
'Color them as empty if they are out and about
Cells(Cells(7 + iPlayer, 24) + Cells(7 + iPlayer, 28) * b, _
Cells(7 + iPlayer, 25) + Cells(7 + iPlayer, 29) * b).Interior.Color _
= Cells(7 + iPlayer, 21).Interior.Color
End If
Next b
End Sub
Clicking the blue Rounded Rectangle displays a Rules TextBox which normally is well out of the way. Assign this macro to it which I've put into modRules.
Sub ShowRules()
Sheet1.Shapes("Text Box 32").Visible = msoCTrue
Application.WindowState = xlNormal
Application.Width = 650
End Sub
The Rules textbox has this macro assigned to it to hide it again.
Sub HideRules()
Sheet1.Shapes("Text Box 32").Visible = msoFalse
Application.WindowState = xlNormal
Application.Width = 350
End Sub
Cheers,
Rudi
I've just started this game!
Sub ShowRules()
Sheet1.Shapes("Text Box 32").Visible = msoCTrue
Application.WindowState = xlNormal
Application.Width = 650
End Sub
The Rules textbox has this macro assigned to it to hide it again.
Sub HideRules()
Sheet1.Shapes("Text Box 32").Visible = msoFalse
Application.WindowState = xlNormal
Application.Width = 350
End Sub
Cheers,
Rudi
I've just started this game!
