Dice Roll Move

[Daven13]

Hi all, I am trying to write a 'board game' in VBA.
I have sorted the code to get the potential available spaces based on position and dice rolled but I am struggling to figure out a way to show actual moves available.

The images show a roll of 9 on the dice (red squares) with the yellow as a starting point but with buildings in the way (grey squares).
I need the code to figure where you can move to within the area (yellow square) after having to go round the buildings (Image 2).

I hope this is clear and any help would be appreciated as I've been racking my brains for several weeks.

Thanks

 

[Legacy 456155]

Help me understand the rules of the game. Does a roll of 9 mean that you MUST move 9 spaces? Or does it simply provide an area of permitted movement. (barring obstructions). I'll explain my question depending upon your answer. I think that you are looking for an algorithm such as Dijkstra's algorithm. Search on that, and in particular, a VBA implementation.

 

[Daven13]

Hi dataluver. The roll permits you to move any direction, even back on previous spaces. So you could end up moving 9 spaces in one direction or could move up then down repeatedly, but yes, the player must move all nine spaces.

 

[Legacy 456155]

Ok. So, in my shot below, from yellow, with a roll of 9, the only squares the user could possibly land on would be the red ones. Correct? An odd roll would only result in a red square and an even roll would only result in a blue square.

Are all of your obstructions ALWAYS a rectangle?
What is the min and max dice roll?
Any other move related rules that you have left out?

 

[Daven13]

That image is absolutely correct. My mistake.
Yes all of the buildings will be rectangles.
It would be 2x 6 dice so between 2 and 12.

Thank you for continuing to help me out with this.

 

[Legacy 456155]

No problem. Iv'e not made a game before and this seems like a fun little project. What approach have you come up with so far as far as determining possible moves? Please post what you have.

 

[Daven13]

I've compiled a slightly briefer version. It's not the prettiest code and I'm sure there is a much simpler way of doing this.
I've chosen a start point and dice roll just for testing at this point and I also added the checkerboard option as you pointed out.

Sub Moves()
Dim Start, Dice, Colouring As String
Start = "S43"
Dice = "12"

Range("B1:AK95").Interior.Color = xlNone
Range("S44:X50").Interior.Color = 12566463
Range("K45:M47").Interior.Color = 12566463

Range(Start).Activate

'Initial Grid
For x = 0 To Dice
For y = 0 To Dice
If Range(Start).Offset(x, y).Interior.Color <> 12566463 And x + y < Dice + 1 Then Range(Start).Offset(x, y).Interior.Color = 255
If Range(Start).Offset(-x, y).Interior.Color <> 12566463 And x + y < Dice + 1 Then Range(Start).Offset(-x, y).Interior.Color = 255
If Range(Start).Offset(x, -y).Interior.Color <> 12566463 And x + y < Dice + 1 Then Range(Start).Offset(x, -y).Interior.Color = 255
If Range(Start).Offset(-x, -y).Interior.Color <> 12566463 And x + y < Dice + 1 Then Range(Start).Offset(-x, -y).Interior.Color = 255
Next y
Next x

Try1:
For t = 1 To 20 '20 Atempts at finding path
Range(Start).Activate

For c = 1 To Dice

For n = 1 To 4
On Error Resume Next
If ActiveCell.Offset(-n, 0).Interior.Color = 255 Then ActiveCell.Offset(-1, 0).Activate: GoTo Colour
If ActiveCell.Offset(0, n).Interior.Color = 255 Then ActiveCell.Offset(0, 1).Activate: GoTo Colour
If ActiveCell.Offset(n, 0).Interior.Color = 255 Then ActiveCell.Offset(1, 0).Activate: GoTo Colour
If ActiveCell.Offset(0, -n).Interior.Color = 255 Then ActiveCell.Offset(0, -1).Activate: GoTo Colour
Next n

Directions: 'If no red near, choose random direction
d = Int((4 - 1 + 1) * Rnd + 1)
If d = 1 And ActiveCell.Offset(-1, 0).Interior.Color <> 12566463 Then ActiveCell.Offset(-1, 0).Activate: GoTo Colour
If d = 2 And ActiveCell.Offset(0, 1).Interior.Color <> 12566463 Then ActiveCell.Offset(0, 1).Activate: GoTo Colour
If d = 3 And ActiveCell.Offset(1, 0).Interior.Color <> 12566463 Then ActiveCell.Offset(1, 0).Activate: GoTo Colour
If d = 4 And ActiveCell.Offset(0, -1).Interior.Color <> 12566463 Then ActiveCell.Offset(0, -1).Activate: GoTo Colour
GoTo Directions

Colour:
If ActiveCell.Interior.Color = 12566463 Then GoTo Try1
ActiveCell.Interior.Color = 0

Next c
Next t

Try2:
For t = 1 To 20
Range(Start).Activate
For c = 1 To Dice

For n = 1 To 7
On Error Resume Next
If ActiveCell.Offset(0, -n).Interior.Color = 255 Then ActiveCell.Offset(0, -1).Activate: GoTo Colour2
If ActiveCell.Offset(n, 0).Interior.Color = 255 Then ActiveCell.Offset(1, 0).Activate: GoTo Colour2
If ActiveCell.Offset(0, n).Interior.Color = 255 Then ActiveCell.Offset(0, 1).Activate: GoTo Colour2
If ActiveCell.Offset(-n, 0).Interior.Color = 255 Then ActiveCell.Offset(-1, 0).Activate: GoTo Colour2
Next n

Direction:
d = Int((4 - 1 + 1) * Rnd + 1)
If d = 1 And ActiveCell.Offset(-1, 0).Interior.Color <> 12566463 Then ActiveCell.Offset(-1, 0).Activate: GoTo Colour2
If d = 2 And ActiveCell.Offset(0, 1).Interior.Color <> 12566463 Then ActiveCell.Offset(0, 1).Activate: GoTo Colour2
If d = 3 And ActiveCell.Offset(1, 0).Interior.Color <> 12566463 Then ActiveCell.Offset(1, 0).Activate: GoTo Colour2
If d = 4 And ActiveCell.Offset(0, -1).Interior.Color <> 12566463 Then ActiveCell.Offset(0, -1).Activate: GoTo Colour2
GoTo Direction

Colour2:
If ActiveCell.Interior.Color = 12566463 Then GoTo Try2
ActiveCell.Interior.Color = 0

Next c
Next t

'Grid......
Range(Start).Offset(-Dice, -Dice).Activate

For x = 0 To (Dice * 2)
For y = 0 To (Dice * 2)
If ActiveCell.Offset(x, y).Interior.Color = 0 And (x + y) Mod 2 = 0 Then ActiveCell.Offset(x, y).Interior.Color = 15773696
Next y
Next x

If Dice Mod 2 = 0 Then Colouring = 0 Else Colouring = 15773696
For x = 0 To (Dice * 2)
For y = 0 To (Dice * 2)
If ActiveCell.Offset(x, y).Interior.Color = Colouring Then ActiveCell.Offset(x, y).Interior.Color = xlNone
Next y
Next x


For x = 0 To (Dice * 2)
For y = 0 To (Dice * 2)
If ActiveCell.Offset(x, y).Interior.Color = 15773696 Then ActiveCell.Offset(x, y).Interior.Color = 192
If ActiveCell.Offset(x, y).Interior.Color = 0 Then ActiveCell.Offset(x, y).Interior.Color = 192
If ActiveCell.Offset(x, y).Interior.Color = 255 Then ActiveCell.Offset(x, y).Interior.Color = xlNone
Next y
Next x

End Sub

 

[Legacy 456155]

I see what you are doing. Our approach is similar. I had in mind working with an array which will probably be faster. This is out of my depth and I am no CS major, but fun = persistence. I'll post what I have when I have something to post.

 

[Daven13]

That's great. Looking forward to see what you come up with.

 

[dominicyberx]

I just stumbled upon this thread and realized it's been sitting here for three years! Time flies, doesn't it? But hey, even though it's been a while, I thought I'd jump in and offer some help.
Writing a board game in VBA sounds like a cool project! Sorting out the code to determine potential available spaces based on position and dice rolls is no small feat.