Help needed to create game

gavinkelly

Board Regular
Joined
Jan 12, 2008
Messages
220
I am trying to create a game i am unsure of the name but it is played on a 10centimeter square grid and 2 opponents take it in turns to draw a single centimeter line on the grid. if an player makes a full square he writes his initial in the square takes another go.
When all the possible lines have been drawn by each player the player with the most initals on the board wins.

So far i have created it for a 2 by 2 grid but if i use this method for a larger grid (e.g.) a 10 by 10 grid it will take me a long long time to write it out and the program will loop more an more times to find an un used line on the grid towards the end of the game (This is because in a 2 by 2 grid there are 12 possible "moves" but each time the computer moves it generates a random number from 1-12 and then checks to see if that move is already taken, if it is taken it generates another random number between 1-12 until it finds a free space. This brute force method will just take far too long as the grid gets larger. I will add AI later but for now can anyone help with this first problem. The code is as follows (sorry it is pretty long but very repetitive)

Code:
Sub CompGo()
Zero:
'i draw first line then computer choses a line
n = 12
Dim MyValue

For Z = 1 To 10000

MyValue = Int((n * Rnd) + 1)
Select Case MyValue
Case 1
If Cells(2, 2).Borders(xlEdgeLeft).LineStyle = xlContinuous Then
GoTo Handler
End If
 Cells(2, 2).Borders(xlEdgeLeft).LineStyle = xlContinuous
 Exit For

Case 2
If Cells(2, 2).Borders(xlEdgeTop).LineStyle = xlContinuous Then
GoTo Handler
End If
 Cells(2, 2).Borders(xlEdgeTop).LineStyle = xlContinuous
 Exit For


Case 3
If Cells(2, 2).Borders(xlEdgeRight).LineStyle = xlContinuous Then
GoTo Handler
End If
 Cells(2, 2).Borders(xlEdgeRight).LineStyle = xlContinuous
 Exit For

Case 4
If Cells(2, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous Then
GoTo Handler
End If
 Cells(2, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
 Exit For

Case 5
If Cells(2, 3).Borders(xlEdgeTop).LineStyle = xlContinuous Then
GoTo Handler
End If
 Cells(2, 3).Borders(xlEdgeTop).LineStyle = xlContinuous
 Exit For

Case 6
If Cells(2, 3).Borders(xlEdgeRight).LineStyle = xlContinuous Then
GoTo Handler
End If
 Cells(2, 3).Borders(xlEdgeRight).LineStyle = xlContinuous
 Exit For

Case 7
If Cells(2, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous Then
GoTo Handler
End If
 Cells(2, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous
 Exit For

Case 8
If Cells(3, 2).Borders(xlEdgeLeft).LineStyle = xlContinuous Then
GoTo Handler
End If
 Cells(3, 2).Borders(xlEdgeLeft).LineStyle = xlContinuous
 Exit For

Case 9
If Cells(3, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous Then
GoTo Handler
End If
 Cells(3, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
 Exit For

Case 10
If Cells(3, 2).Borders(xlEdgeRight).LineStyle = xlContinuous Then
GoTo Handler
End If
 Cells(3, 2).Borders(xlEdgeRight).LineStyle = xlContinuous
 Exit For

Case 11
If Cells(3, 3).Borders(xlEdgeRight).LineStyle = xlContinuous Then
GoTo Handler
End If
 Cells(3, 3).Borders(xlEdgeRight).LineStyle = xlContinuous
 Exit For

Case 12
 Cells(3, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous

If Cells(3, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous Then
GoTo Handler
End If
 Cells(3, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous
 Exit For

End Select
Handler:

Next Z
M = 0
If IsEmpty(Cells(2, 2)) Then
    If Cells(2, 2).Borders(xlEdgeRight).LineStyle = xlContinuous And Cells(2, 2).Borders(xlEdgeLeft).LineStyle = xlContinuous And Cells(2, 2).Borders(xlEdgeTop).LineStyle = xlContinuous And Cells(2, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous Then
    Cells(2, 2) = "C"
    M = 1
    End If
End If

If IsEmpty(Cells(2, 3)) Then
    If Cells(2, 3).Borders(xlEdgeRight).LineStyle = xlContinuous And Cells(2, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous And Cells(2, 3).Borders(xlEdgeTop).LineStyle = xlContinuous And Cells(2, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous Then
    Cells(2, 3) = "C"
    M = 1
    End If
End If

If IsEmpty(Cells(3, 2)) Then
    If Cells(3, 2).Borders(xlEdgeRight).LineStyle = xlContinuous And Cells(3, 2).Borders(xlEdgeLeft).LineStyle = xlContinuous And Cells(3, 2).Borders(xlEdgeTop).LineStyle = xlContinuous And Cells(3, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous Then
    Cells(3, 2) = "C"
    M = 1
    End If
End If

If IsEmpty(Cells(3, 3)) Then
    If Cells(3, 3).Borders(xlEdgeRight).LineStyle = xlContinuous And Cells(3, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous And Cells(3, 3).Borders(xlEdgeTop).LineStyle = xlContinuous And Cells(3, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous Then
    Cells(3, 3) = "C"
    M = 1
    End If
End If
 If M = 1 Then
 GoTo Zero:
 End If




End Sub
Sub MyGo()
n = 0
If IsEmpty(Cells(2, 2)) Then
    If Cells(2, 2).Borders(xlEdgeRight).LineStyle = xlContinuous And Cells(2, 2).Borders(xlEdgeLeft).LineStyle = xlContinuous And Cells(2, 2).Borders(xlEdgeTop).LineStyle = xlContinuous And Cells(2, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous Then
    Cells(2, 2) = "G"
    n = 1
    End If
End If

If IsEmpty(Cells(2, 3)) Then
    If Cells(2, 3).Borders(xlEdgeRight).LineStyle = xlContinuous And Cells(2, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous And Cells(2, 3).Borders(xlEdgeTop).LineStyle = xlContinuous And Cells(2, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous Then
    Cells(2, 3) = "G"
    n = 1
    End If
End If

If IsEmpty(Cells(3, 2)) Then
    If Cells(3, 2).Borders(xlEdgeRight).LineStyle = xlContinuous And Cells(3, 2).Borders(xlEdgeLeft).LineStyle = xlContinuous And Cells(3, 2).Borders(xlEdgeTop).LineStyle = xlContinuous And Cells(3, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous Then
    Cells(3, 2) = "G"
    n = 1
    End If
End If

If IsEmpty(Cells(3, 3)) Then
    If Cells(3, 3).Borders(xlEdgeRight).LineStyle = xlContinuous And Cells(3, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous And Cells(3, 3).Borders(xlEdgeTop).LineStyle = xlContinuous And Cells(3, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous Then
    Cells(3, 3) = "G"
    n = 1
    End If
End If

If n = 1 Then
MsgBox ("Take another go")

Else
Call CompGo
End If

End Sub
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
updated a little more
check link again if you already downloaded

the link is only temporary
till new version or till I need more space on my site

CAVEAT
Download the file
Do not try to play online: that won't work!
 
Upvote 0
Ignore my last post, i just figured it out, very good, any ideas on some good AI for a computer opponent, i was thinking about 3 levels-

easy -where the computer just totally randomly choses any position. I figured that each available move is assigned a number and then the rnd function is used to pick that number and so pick that line.

medium- computer looks for 3 lines to a box first to get a square then looks for zero or one line to a box so not to give the opponent the chance to get a box. The computer loops through all cells first seeing if any has 3 lines, if not it loops again seeing if any have zero or one andthen chose the a line here (aslong as it does not cause an adjacent cell to have 3 lines) This will however cause an uneven grouping of lines in the first cells the code loops through - not that this is a problem really but i guess a random cell could be chosen and the computer then loop through all cells from that point onwards

hard- the computer plans moves in advance (i have no idea how to do this though)
 
Upvote 0
The computer loops through all cells first seeing if any has 3 lines, if not it loops again seeing if any
you shouldn't loop if it is not necessary
I used a system which is putting numbers into the cells.
You can replace 1, 2, 4, 8 by 1, 1, 1, 1 if you like.
A simple "find" could help the AI to check for 3 lines, ...

I am not sure, but my system could be good for more advanced AI.

Don't know if you saw the reason for 1, 2, 4, 8
R = right border, B = bottom, L = left, T = top
00: no borders
01: R
02: B
03: BR
04: L
05: LR
06: LB
07: LBR
08: T
09: TR
10: TB
11: TBR
12: TL
13: TLR
14: TLB
15: TLBR

Perhaps looking at the SUM of ranges of 2, 4, 6 or 9 cells would help the AI...
 
Upvote 0
Erik, you are much to busy to be playing around with games. I know that for a fact.

lenze
 
Upvote 0
Erik, you are much to busy to be playing around with games. I know that for a fact.

lenze
lenze, thanks so much for your concern to protect me from Excel activities :rofl:

that depends ...
I can not decide about certain "facts" that you know
well, I am not going to m.... with Y.....
but am continuing to search for "my" w....

in the mean time, I am getting my useful distraction here :-)

quite optimistic for the future :biggrin:
I'll certainly let you guys know, when everything is "settled"

and - because this is not the Lounge nor our "private Lounge" ;) -, did you try the game?
 
Upvote 0
Cool Eric. When you are finished, we'll compare notes and make it work over the internet and go head to head or "square to square". :) I am teaching my son a bit about programming and this game has got his interest. It is fun. However, I can't get over the free drawing rule. It seems more fun if you have to intersect a previously drawn line. I will just make up my own rules. :)

Keep up the good fun!
 
Upvote 0
Tom,

Adding rules will be easy. The code I am making is already quite modularised (if that's good english).
Last night I concentrated on some nice pencil drawing. Looks cool to me.
Today, yes it's hollidays for me, I will perhaps find out some tricks with a sponge, when changing the names of the players :-) Just to make it funny :laugh:

It will be very easy to resize the playground if necessary.

QUESTION TO ALL: ADDING A RULE (which we forgot to my sense)
Shouldn't the playground have a border from start?

kind regards,
Erik

PS
Tom, what did you mean by
we'll compare notes
Are you working on this too? Can you show it?
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,180
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top