seeking help with a project.......!, Gomoku or 5 in a row Game

hello everyone...........

im working on a project in vb6. the project is a game called 5 in a row........its like tic tac toe but on a bigger grid....i have got a 19 x 19 grid..the grid is made using labels. so i have 361 labels...all the labels are in an array ..when a user click it put X or O.........currently it two players game....noughts and crosses........now i need help in check if noughts or crosses are 5 in row ...it could be Vertically, horizontally or diagonally..........i got Vertically and horizontally working............

im wondering if anyone can help me with diagional checking ..................thnx

the code that i used is like

Code:

---

Function Check(turn As String) As Boolean 'check for victory

Dim X, Y, index As Integer
Dim InARow As Integer

' check for horizontal win
For Y = 0 To 18
InARow = 0

For X = 0 To 18
index = (Y * 19) + X

If Label1(index).Caption = turn Then
InARow = InARow + 1
If InARow >= 5 Then GoTo FoundWinner
Else
InARow = InARow - 1
If InARow < 0 Then InARow = 0
End If
Next X
Next Y

' check for vertical win
For X = 0 To 18
InARow = 0

For Y = 0 To 18
index = (Y * 19) + X

If Label1(index).Caption = turn Then
InARow = InARow + 1
If InARow >= 5 Then GoTo FoundWinner
Else
InARow = InARow - 1
If InARow < 0 Then InARow = 0
End If
Next Y
Next X

FoundWinner:

If InARow >= 5 Then
'==========================Player 1==================================
If turn = "X" Then
MsgBox "Player 1 wins!"

player1_score = player1_score + 1
lbl_player1score.Caption = player1_score

cleargrid


End If


'==========================Player 2==================================
If turn = "O" Then
MsgBox "player 2 wins!"

player2_score = player2_score + 1
lbl_player2score.Caption = player2_score

cleargrid

End If

End If

End Function

---

Welcome to the forums.

Diagonals are sort of easy, the only problem is to determine when you are on the left/right edge. To move down in the diagonal just add either 18 or 20 depending on the direction. To move up, simply subtract that amount. There are some efficiency tweaks that can be applied to the posted code below, but the logic should work.

The code below also uses a slightly better horizontal & vertical check. In your code, if the player made 5th in a row on the far right column, then your loops would check all 19 labels on that row. The following will check no more than 5 in that case and no more than 6 in any other case, regardless of direction. Why did I check for matches of 4 vs 5? Well, the index passed to the function would be a match automatically, so no need to check it again.

Why use Mod? If index is on the left edge, then the Index Mod 19 will always be zero else it will not. If on the right edge, then the Index Mod 19 will always be 18 else it will not. Using Mod makes it easy to check for edges, but other methods can be used also

Code:

---

Dim nrMatches As Long, X As Long
' Horizontal matches
    ' Horizontal Left
    For X = Index - 1 To (Index \ 19) * 19 Step -1
        If Label1(Index).Caption <> Label1(X).Caption Then Exit For
        nrMatches = nrMatches + 1
        If nrMatches = 4 Then GoTo Winner
    Next
    ' Horizontal Right
    For X = Index + 1 To (Index \ 19) * 19 + 18
        If Label1(Index).Caption <> Label1(X).Caption Then Exit For
        nrMatches = nrMatches + 1
        If nrMatches = 4 Then GoTo Winner
    Next
' Vertical matches
    ' Vertical up
    nrMatches = 0
    For X = Index - 19 To 0 Step -19
        If Label1(Index).Caption <> Label1(X).Caption Then Exit For
        nrMatches = nrMatches + 1
        If nrMatches = 4 Then GoTo Winner
    Next
    ' vertical down
    For X = Index + 19 To 360 Step 19
        If Label1(Index).Caption <> Label1(X).Caption Then Exit For
        nrMatches = nrMatches + 1
        If nrMatches = 4 Then GoTo Winner
    Next
' Diagonal matches (top.left to bottom.right)
    nrMatches = 0
    ' Diagonal Up|Left
    For X = Index - 20 To 0 Step -20
        If Label1(Index).Caption <> Label1(X).Caption Then Exit For
        nrMatches = nrMatches + 1
        If nrMatches = 4 Then GoTo Winner
        If X Mod 19 = 0 Then Exit For ' on left edge
    Next
    ' Diagonal Down/Right
    For X = Index + 20 To 360 Step 20
        If Label1(Index).Caption <> Label1(X).Caption Then Exit For
        nrMatches = nrMatches + 1
        If nrMatches = 4 Then GoTo Winner
        If X Mod 19 = 18 Then Exit For ' on right edge
    Next
' Diagonal matches (top.right to bottom.left)
    nrMatches = 0
    ' Diagonal Up|Right
    For X = Index - 18 To 0 Step -18
        If Label1(Index).Caption <> Label1(X).Caption Then Exit For
        nrMatches = nrMatches + 1
        If nrMatches = 4 Then GoTo Winner
        If X Mod 18 = 19 Then Exit For ' on right edge
    Next
    ' Diagonal Down|Left
    For X = Index + 18 To 360 Step 18
        If Label1(Index).Caption <> Label1(X).Caption Then Exit For
        nrMatches = nrMatches + 1
        If nrMatches = 4 Then GoTo Winner
        If X Mod 19 = 0 Then Exit For ' on left edge
    Next
' no winner
Exit Sub

Winner:
MsgBox "Winner"

---

Edited: Expanding a little on the faster checks statement I made above. If no winning move was made, your routines would actually check 76 labels before it finishes. The checks above will check no more than 24. You might also consider avoiding running the checks until a player has made at least 5 moves.

LaVolpe thnx alot for ur time..............
i tried to use ur code but when i click on label it gives me message box saying winner.......without letting other player to have a go...could u plz check


im attaching my game page .....plz have a look
thnx

Moved To Games Programming

sombody plz help
:ehh:

Actually this is pretty easy, you see for any given 5X5 matrix there are only 12 possible winning combinations - these matrices can be defined in a binary number and masked then compared with a winning combo. as for scanning you only need to scan 15X15 boxes of the 5X5 matrix in short the code is very small and precise.

In the declarations add the mask array:

Code:

---

Option Explicit

Dim player1 As Boolean ' Declared for player to take turn
Dim player1_score As Integer  'player 1 score counter
Dim player2_score As Integer  'player 2 score counter
Dim mask(0 To 11) As Long

---

In the Form Load Routine you set up the masks like this

Code:

---

Private Sub Form_Load()
player1 = True
player_lbl.Caption = "Player 1 go first"

mask(0) = &H1F
mask(1) = &H3E0
mask(2) = &H7C00
mask(3) = &HF8000
mask(4) = &H1F00000
mask(5) = &H1084210
mask(6) = &H842108
mask(7) = &H421084
mask(8) = &H210842
mask(9) = &H108421
mask(10) = &H1041041
mask(11) = &H111110
End Sub

---

Change the check routine to this and your done:

Code:

---

Public Sub Check(turn As String)                    'check for victory
Dim matrix As Long, x As Integer, y As Integer
Dim i As Integer, j As Integer, index As Integer

For x = 0 To 14
    For y = 0 To 14
        'build matrix
        matrix = 0
        For i = 0 To 4
            For j = 0 To 4
                index = (y + j) * 19 + (x + i)
                matrix = matrix * 2 + IIf(Label1(index) = turn, 1, 0)
            Next
        Next
        ' check for patterns
        For i = 0 To 11
            If (matrix And mask(i)) = mask(i) Then GoTo Winner
        Next
    Next
Next
Exit Sub

Winner:
MsgBox "Winner"

End Sub

---

...and yes I am a major math geek.

Here are some things I observed. When you click on new game the text colors of the labels aren't reset. so sometimes X comes out white. I would add a:
Label1(index).ForeColor = vbBlack
to the X's turn like you do with the white.

Also you don't set a flag to end the game - you can do that right after the Winner! announcement. This can be used to stop player from clicking on boxes once someone has won.

technorobbo, Great work mate.........thnx very much...........

could u plz explain me
mask(0) = &H1F
mask(1) = &H3E0
mask(2) = &H7C00
mask(3) = &HF8000
mask(4) = &H1F00000
mask(5) = &H1084210
mask(6) = &H842108
mask(7) = &H421084
mask(8) = &H210842
mask(9) = &H108421
mask(10) = &H1041041
mask(11) = &H111110

and the check function briefly.............
i ll be very thankfull
thnx


av u got msn ...or can we have a chat....?

No Problem.

The winning combinations all fit into a 5X5 matrix.
within that matrix there are 5 horizontal combinations ,5 vertical and 2 diagonal. 12 in all. The 5X5 matrix can be represented as a 25 bit number. 1 bit for each cell of course.

Scanning each 5X5 matrix top to bottom - left to right. I was able to construct the 25 bit number by multiplying by 2 and adding a bit if the cell was set to the proper token (X or O). This is known as a logical shift left or LSR.

The masks represent the 12 possible combinations:
&H1F (31 in decimal) represents this pattern in Binary

0000100001000010000100001

and if layed out in a matrix it looks like this

00001
00001
00001
00001
00001

A winning pattern. I worked all the patterns out in excel by the way.
&H1041041 (17043521 in decimal) represents


10000
01000
00100
00010
00001

etc.
To check the matrices I did a bitwise "and" to isolate only the bits required and checked to see if the remaining pattern was equal (=) to the mask.

thnx alot for detailed explaination..........i m a abit confuse about the loops u used

For i = 0 To 4
For j = 0 To 4
index = (y + j) * 19 + (x + i)
matrix = matrix * 2 + IIf(Label1(index) = turn, 1, 0)
Next
Next
' check for patterns
For i = 0 To 11
If (matrix And mask(i)) = mask(i) Then GoTo Winner

could u explain this as well.......
thnx

The XY loops scan the board for 5X5 matrices.

the IJ loop populates the 25 bit variable (Long integer is used to store).

the I=0 to 11 loop compares the 25 Bit variable to the winning masks.

Matrix *2 shifts the 25bit variable to left.

+ IIf(Label1(index) = turn, 1, 0) - turns the low order bit on or off depending on a an X or O being in the label.

matrix and mask(i) isolates only the bits in the mask (this is the actual masking function).

=mask(i) compares those bits to the mask

great stuff mate.........

thnx alot

now i got my project working with the help of u guys...........i want to go one step forward and want to build an automated player 2 means player1 vs computer..........
i m thinking a system where player1 goes first then the system should search through the grid and make the best possible move.............

any suggestions guys...........?

2700 possible winning combinations (15X15X12). Scan them all to see if they are available. First scan defensively and rate by the number of filled in pieces by you opponent. Block the one with the most pieces. Then Scan offensively fill in the one with the most pieces. check for winner. The real trick is to think 1 or 2 boards (maybe more) ahead and anticipate the players move. You can write a thesis on that.

scanning will be too slow as the grid is too big........if i change it to 9X9 grid then it might speed up the scanning............
any algorithm that can do this process..............
i read a bit about MINIMAX or tress search.........av u got any idea about that?

i tried to change the grid to 9 x 9 ........i got an error regarding array not found

matrix = matrix * 2 + IIf(Label1(index) = turn, 1, 0)

the error is in this code

help plz.......!

I would have to see the whole code to troubleshoot. And actually 2700 scans would be rather quick. The current check sub routine does exactly that!

this is 9 x 9 grid program............
got problem with it....

I'll have to open it when I get home, but, seriously consider keeping it at 19X19. Thats not much of a drain on the computers resources.

yah my cousin just told me that dont go for 9 x 9 ..........19 x 19 is looking good........the code u gave me, he likes it............

will u plz help me in the best move search...................

my cousin told me to have a look at alpha beta search for best move.........what do u say about that?

Let me throw some code at it and see what happens.

I have an Idea on how to scan. Out of the 2700 possible win combos, the only ones that can win at any given time is the ones that contain a computer token (lets say X), and no O's. Any Combo's that has only O's and no X's pose a threat and need to be capped. The ones with the more O's pose the biggest threat. 4-O's require an immediate response. Any combo with 4 X's are an immediate win and should be checked for first. If the max O count ( of any O only combo) is greater the max X count ( of any X only combo) you defend. If the Max X count is greater than O count you attack.

Using the same code as the check routine you can check for a masked matrix value >0 for both player and computer and isolate the combos that matter, and ignore the rest.

Here's a purely defensive routine - the ground work is layed out to make offensive decisions also but I thought I'd post thiis so you can examine the code. There's no minimax tree used this would be just the heuristic portion of the algorithm. This is just to give you an idea how quickly the board can be analyzed.

It rates the possible combos and addresses the biggest threats. At the end it clicks on a box (the computer is O's, it's watching out for X's).

Code:

---

Private Sub AIsTurn()
Dim Omatrix As Long, Xmatrix As Long, x As Integer, y As Integer
Dim i As Integer, j As Long, index As Integer, tmp As Long
Dim Xs() As Long, Os() As Long, newI As Integer

Const Cx = 0
Const Cy = 1
Const max = 2
Const bits = 3
Const bmask = 4
Const HighBit = 2 ^ 24

ReDim Os(0 To 4, 0 To 0)
ReDim Xs(0 To 4, 0 To 0)

For x = 0 To 14
    For y = 0 To 14
        'build matrices
        Omatrix = 0
        Xmatrix = 0
        For i = 0 To 4
            For j = 0 To 4
                index = (y + j) * 19 + (x + i)
                Omatrix = Omatrix * 2 + IIf(Label1(index) = "O", 1, 0)
                Xmatrix = Xmatrix * 2 + IIf(Label1(index) = "X", 1, 0)
            Next
        Next
        ' check for winnable combos
        For i = 0 To 11
            If (Omatrix And mask(i)) > 0 And (Xmatrix And mask(i)) = 0 Then
                newI = UBound(Os, 2) + 1
                ReDim Preserve Os(0 To 4, 0 To newI)
                Os(Cx, newI) = x: Os(Cy, newI) = y
                Os(bits, newI) = Omatrix And mask(i) Xor mask(i)
                Os(bmask, newI) = mask(i)
                j = Os(bits, newI)
                Os(max, newI) = 0
                Do While j > 0
                    Os(max, newI) = Os(max, newI) + (j And 1)
                    j = Int(j / 2)
                Loop
            End If
            If (Xmatrix And mask(i)) > 0 And (Omatrix And mask(i)) = 0 Then
                newI = UBound(Xs, 2) + 1
                ReDim Preserve Xs(0 To 4, 0 To newI)
                Xs(Cx, newI) = x: Xs(Cy, newI) = y
                Xs(bits, newI) = Xmatrix And mask(i) Xor mask(i)
                Xs(bmask, newI) = mask(i)
                j = Xs(bits, newI)
                Xs(max, newI) = 0
                Do While j > 0
                    Xs(max, newI) = Xs(max, newI) + (j And 1)
                    j = Int(j / 2)
                Loop
            End If
        Next
    Next
Next
'sort X's

i = LBound(Xs, 2)
While i < (UBound(Xs, 2) + 1)
    If i = LBound(Xs, 2) Then
        i = i + 1
    ElseIf Xs(max, i - 1) <= Xs(max, i) Then
        i = i + 1
    Else
        tmp = Xs(max, i): Xs(max, i) = Xs(max, i - 1): Xs(max, i - 1) = tmp
        tmp = Xs(Cx, i): Xs(Cx, i) = Xs(Cx, i - 1): Xs(Cx, i - 1) = tmp
        tmp = Xs(Cy, i): Xs(Cy, i) = Xs(Cy, i - 1): Xs(Cy, i - 1) = tmp
        tmp = Xs(bits, i): Xs(bits, i) = Xs(bits, i - 1): Xs(bits, i - 1) = tmp
        tmp = Xs(bmask, i): Xs(bmask, i) = Xs(bmask, i - 1): Xs(bmask, i - 1) = tmp
        i = i - 1
    End If
Wend
'sort Os
i = LBound(Os, 2)
While i < (UBound(Os, 2) + 1)
    If i = LBound(Os, 2) Then
        i = i + 1
    ElseIf Os(max, i - 1) <= Os(max, i) Then
        i = i + 1
    Else
        tmp = Os(max, i): Os(max, i) = Os(max, i - 1): Os(max, i - 1) = tmp
        tmp = Os(Cx, i): Os(Cx, i) = Os(Cx, i - 1): Os(Cx, i - 1) = tmp
        tmp = Os(Cy, i): Os(Cy, i) = Os(Cy, i - 1): Os(Cy, i - 1) = tmp
        tmp = Os(bits, i): Os(bits, i) = Os(bits, i - 1): Os(bits, i - 1) = tmp
        tmp = Os(bmask, i): Os(bmask, i) = Os(bmask, i - 1): Os(bmask, i - 1) = tmp
        i = i - 1
    End If
Wend

'set O Defensive
Dim bitGroup(0 To 4) As Long
i = 0
x = 0
tmp = HighBit
'construct bit image

Do While tmp
    If (Xs(bmask, 1) And tmp) > 0 Then
        If (Xs(bits, 1) And tmp) > 0 Then
            bitGroup(i) = x + 1 '
            i = i + 1
        Else
            bitGroup(i) = -(x + 1)
            i = i + 1
        End If
    End If
    x = x + 1
    tmp = Int(tmp / 2)
Loop

'check for adjacency
For i = 0 To 3
   
    If (Sgn(bitGroup(i)) <> Sgn(bitGroup(i + 1))) Then
        If bitGroup(i) > 0 Then
            x = bitGroup(i) - 1
        Else
            x = bitGroup(i + 1) - 1
        End If
    End If
Next

y = (Xs(Cy, 1) + (x Mod 5)) * 19 + (Xs(Cx, 1) + Int(x / 5))

Label1_Click y
End Sub

---

thnx mate .......

So i call AIsTurn in label_click routine right?
shall i remove the check function?

don't remove the check function, it's independent of the check function. It should be called after the check function is called in the live players turn, if no one has one the game yet.

Call Check
Call AIsTurn

It will act like a virtual player and click on a label when it's done. No change is needed to your program.

You may want to add an option to play against machine or human. It's kind of quick so you may want to add a minimum delay for more realistic game play.

yah i did it this way its giving me error in

AIsturn function.....

u can have a look at it when u get home..........! its not that urgent......
thnx

It was written for the 19X19 code in Post #3 - I assume there have been significant changes since.

You did modify the code. AI'sTurn was programmed to work as if it were a player. Just change your Label1_Click Routine back to the old code and your fine. No Modification needed.

You will have to stop it from trying to play after the game has ended - You may have to add a boolean to mark game over.

You old Code with AI'sTurn added:

Code:

---

Public Sub Label1_Click(index As Integer)
If player1 = True Then
    If Label1(index).Caption = "" Then
        Label1(index).Caption = "X"
        Label1(index).ForeColor = vbBlack
        player1 = False
        player_lbl.Caption = "Player 2 to take turn"
        '------------------------------------------------------------------------------------
        'to check for winner.....................................
        '------------------------------------------------------------------------------------
        Check "X"
       
        AIsTurn

        'this should be modified with a boolean flag like this:
        'If gameover = False Then AIsTurn
        'gameover should be set in the Check routine

    End If
ElseIf player1 = False Then
    If Label1(index).Caption = "" Then
        Label1(index).Caption = "O"
        Label1(index).ForeColor = vbWhite
        player1 = True
        player_lbl.Caption = "Player 1 to take turn"
        '------------------------------------------------------------------------------------
        'to check for winner.....................................
        '------------------------------------------------------------------------------------
        Check "O"
  End If
End If
End Sub

---

duplcate post deleted

duplicate post deleted

i ll give it a Go.........
thnx alot

hello mate.........could u do me one favour.
could u plz write some comments (what the code does) against the code for AIsTurn procedure so that i can understand the coding............its a bit complicated for me as im not that experienced............
thnx

Wow this is a thesis:

Code:

---

Private Sub AIsTurn()
Dim Omatrix As Long, Xmatrix As Long, x As Integer, y As Integer
Dim i As Integer, j As Long, index As Integer, tmp As Long
Dim Xs() As Long, Os() As Long, newI As Integer

Const Cx = 0
Const Cy = 1
Const max = 2
Const bits = 3
Const bmask = 4
Const HighBit = 2 ^ 24

ReDim Os(0 To 4, 0 To 0) 'Computers advantages are saved in this array
ReDim Xs(0 To 4, 0 To 0) 'Players advantages are saved in this array




For x = 0 To 14        'Scan 225 5X5 Matrices for any of the 12 winning combos       
    For y = 0 To 14 '

        'build matrices
        Omatrix = 0
        Xmatrix = 0
        For i = 0 To 4 'convert Matrices to serial binary stream
            For j = 0 To 4 '
                index = (y + j) * 19 + (x + i) 'Translate Cartesian coordinates to countinous array indexing
               
                Omatrix = Omatrix * 2 + IIf(Label1(index) = "O", 1, 0) 'Shift binary stream to the left and set bits for Os
                Xmatrix = Xmatrix * 2 + IIf(Label1(index) = "X", 1, 0) 'Shift binary stream to the left and set bits for Os
            Next
        Next
          'End of build matrices

        ' check for winnable combos - compare matrices with winning 12 masks (12*225=2700 passes)
        For i = 0 To 11
                'the following logic to all combos
                'if a winnable combination is occupied with both Xs and Os then it is not a threat to the computer
                'if a winnable combination is occupied with both Xs and Os then it is not winnable by the computer
                'if a winnable combo is occupied only by the player it's is considered threat and rated by number of Xs
                'if a winnable combo is occupied only by the computer it's is considered winnable and rated by number of Os
                'friendly check
            If (Omatrix And mask(i)) > 0 And (Xmatrix And mask(i)) = 0 Then 'Check for Winnable combo Os with no Xs
                newI = UBound(Os, 2) + 1                                'find new array index
                ReDim Preserve Os(0 To 4, 0 To newI)                'add to array
                Os(Cx, newI) = x: Os(Cy, newI) = y                'store matrix coords
                Os(bits, newI) = Omatrix And mask(i) Xor mask(i) 'check for open positions by inverting bits
                Os(bmask, newI) = mask(i)                                        'store mask bits to idnetify combo
                j = Os(bits, newI)                                                'get temporary clone of bits
                Os(max, newI) = 0                                                'set Winnable  level to zero
                Do While j > 0                                                'count playable open bits equals level
                    Os(max, newI) = Os(max, newI) + (j And 1)        '1 bit would mean that combo wins the game.
                    j = Int(j / 2)
                Loop
            End If
                'unfriendly check
            If (Xmatrix And mask(i)) > 0 And (Omatrix And mask(i)) = 0 Then 'Check for Threat combo Xs with no Os
                newI = UBound(Xs, 2) + 1                                        'find new array index
                ReDim Preserve Xs(0 To 4, 0 To newI)                        'add to array
                Xs(Cx, newI) = x: Xs(Cy, newI) = y                        'store matrix coords
                Xs(bits, newI) = Xmatrix And mask(i) Xor mask(i)        'check for open positions by inverting bits
                Xs(bmask, newI) = mask(i)                                        'store mask bits to identify combo
                j = Xs(bits, newI)                                                'get temporary clone of bits
                Xs(max, newI) = 0                                                'set threat level to zero
                Do While j > 0                                                'count playable open bits equals level
                    Xs(max, newI) = Xs(max, newI) + (j And 1)        '1 bit would mean that combo wins the game.

                    j = Int(j / 2)
                Loop
            End If
        Next
    Next
Next

'End of Scan (225 5X5 Matrices for any of the 12 winning combos


'sort X's
'gnome sort sets the order of the threats from highes to lowest - google gnome sort

i = LBound(Xs, 2)
While i < (UBound(Xs, 2) + 1)
    If i = LBound(Xs, 2) Then
        i = i + 1
    ElseIf Xs(max, i - 1) <= Xs(max, i) Then
        i = i + 1
    Else
        tmp = Xs(max, i): Xs(max, i) = Xs(max, i - 1): Xs(max, i - 1) = tmp
        tmp = Xs(Cx, i): Xs(Cx, i) = Xs(Cx, i - 1): Xs(Cx, i - 1) = tmp
        tmp = Xs(Cy, i): Xs(Cy, i) = Xs(Cy, i - 1): Xs(Cy, i - 1) = tmp
        tmp = Xs(bits, i): Xs(bits, i) = Xs(bits, i - 1): Xs(bits, i - 1) = tmp
        tmp = Xs(bmask, i): Xs(bmask, i) = Xs(bmask, i - 1): Xs(bmask, i - 1) = tmp
        i = i - 1
    End If
Wend

'sort Os
'gnome sort sets the order of the winnables from highest to lowest
i = LBound(Os, 2)
While i < (UBound(Os, 2) + 1)
    If i = LBound(Os, 2) Then
        i = i + 1
    ElseIf Os(max, i - 1) <= Os(max, i) Then
        i = i + 1
    Else
        tmp = Os(max, i): Os(max, i) = Os(max, i - 1): Os(max, i - 1) = tmp
        tmp = Os(Cx, i): Os(Cx, i) = Os(Cx, i - 1): Os(Cx, i - 1) = tmp
        tmp = Os(Cy, i): Os(Cy, i) = Os(Cy, i - 1): Os(Cy, i - 1) = tmp
        tmp = Os(bits, i): Os(bits, i) = Os(bits, i - 1): Os(bits, i - 1) = tmp
        tmp = Os(bmask, i): Os(bmask, i) = Os(bmask, i - 1): Os(bmask, i - 1) = tmp
        i = i - 1
    End If
Wend

'set O Defensive

Dim bitGroup(0 To 4) As Long
i = 0
x = 0
tmp = HighBit
'construct bit image

'condense most highest rated combos to 5 byte pattern for the comparison
'players X gets converted to a negative number
'computer's O gets converted to a positive number
Do While tmp
    If (Xs(bmask, 1) And tmp) > 0 Then
        If (Xs(bits, 1) And tmp) > 0 Then
            bitGroup(i) = x + 1 '
            i = i + 1
        Else
            bitGroup(i) = -(x + 1)
            i = i + 1
        End If
    End If
    x = x + 1
    tmp = Int(tmp / 2)
Loop

'check for adjacency (negative next to a positive number)
'Cap the most threatening combo to disable it.
'If the capping O is not adjacent to a players X then the combo is shifted but not disabled

For i = 0 To 3
    If (Sgn(bitGroup(i)) <> Sgn(bitGroup(i + 1))) Then
        If bitGroup(i) > 0 Then
            x = bitGroup(i) - 1
        Else
            x = bitGroup(i + 1) - 1
        End If
    End If
Next

'convert cartesian to array index
y = (Xs(Cy, 1) + (x Mod 5)) * 19 + (Xs(Cx, 1) + Int(x / 5))

'simulate clicking on label

Label1_Click y

End Sub

---

Remember I haven't included the offensive side of the code but all the info is there to make that decision. Levels are stored as max in the array it stands for maximum number of empty spaces left to fill. Deciding which move to make (offensive / defensive) is basiccally comparing the offensive and defensive level and taking the lower. Lower X' level means the highest threat, 1 X left for the player (not the computer) to win then you must block. if the O's lowest level is a 1 then you have to take that one because that's an immediate win.

thnx mate...great stuff...

one more thing im trying to do that u told to add a gamerover boolean in check routine.....i add it at the end when no winner is found and said in the click label routine that gameover=false then call AI....
is that why to do it?

Sure , put the GameOver in the declarations
At the start of a game or a new game reset set it to false - when there's a winner set it to true.
and use the logic:
If gameover = False Then AIsTurn

You may also stop it from running the check routine and not allow players to set X or O if you want (setting the labels to "" would accomplish that).

thnx alot

hello mate........the AI player is very very good. but the only thing i want to ask is the AI try to stop player 1 from winning. but it never tries to win.

like is a player puts 3 in a row or 4 in a row it will stop it from winning but the AI would never try to win itself..........
is there any way...........
thnx

Remember I haven't included the offensive side of the code but all the info is there to make that decision. Levels are stored as max in the array it stands for maximum number of empty spaces left to fill. Deciding which move to make (offensive / defensive) is basiccally comparing the offensive and defensive level and taking the lower. Lower X' level means the highest threat, 1 X left for the player (not the computer) to win then you must block. if the O's lowest level is a 1 then you have to take that one because that's an immediate win.

thnx

If you still have post you can routine so we can help.

plz help me with the offensive side as well........but if we add offensive side to it the AI will become unbeatable isn't it? i dont it to be unbeatabe but a strong player..........
thnx

can you post what you have so far so?

i didnt do anything......was just playing with but didnt get anywhere...:(

Okay here it is , I just mirrored the defensive logic and added a couple of if then's to round out the logic. I beat it once ( I got lucky) so it's not unbeatable, but it's a great opponent.

thnx alot great programming..........but again i would like u to add some comments so i can fully understand the coding.......thnx

this bit plz

Code:

---

'set O Defensive
Dim bitGroup(0 To 4) As Long
x = 0
i = 0
tmp = HighBit

If UBound(Os, 2) = 0 Then GoTo Defense
If Os(max, 1) > Xs(max, 1) Then GoTo Defense
   
Offense:
    'construct bit image
   
    Do While tmp
        If (Os(bmask, 1) And tmp) > 0 Then
            If (Os(bits, 1) And tmp) > 0 Then
                bitGroup(i) = x + 1 '
                i = i + 1
            Else
                bitGroup(i) = -(x + 1)
                i = i + 1
            End If
        End If
        x = x + 1
        tmp = Int(tmp / 2)
    Loop
   
    'check for adjacency
    For i = 0 To 3
       
        If (Sgn(bitGroup(i)) <> Sgn(bitGroup(i + 1))) Then
            If bitGroup(i) > 0 Then
                x = bitGroup(i) - 1
            Else
                x = bitGroup(i + 1) - 1
            End If
        End If
    Next
   
    y = (Os(Cy, 1) + (x Mod 5)) * 19 + (Os(Cx, 1) + Int(x / 5))
   
    'click it
    Label1_Click y
    Exit Sub
   
Defense:
    'construct bit image
   
    Do While tmp
        If (Xs(bmask, 1) And tmp) > 0 Then
            If (Xs(bits, 1) And tmp) > 0 Then
                bitGroup(i) = x + 1 '
                i = i + 1
            Else
                bitGroup(i) = -(x + 1)
                i = i + 1
            End If
        End If
        x = x + 1
        tmp = Int(tmp / 2)
    Loop
   
    'check for adjacency
    For i = 0 To 3
       
        If (Sgn(bitGroup(i)) <> Sgn(bitGroup(i + 1))) Then
            If bitGroup(i) > 0 Then
                x = bitGroup(i) - 1
            Else
                x = bitGroup(i + 1) - 1
            End If
        End If
    Next
   
    y = (Xs(Cy, 1) + (x Mod 5)) * 19 + (Xs(Cx, 1) + Int(x / 5))

    'click it
    Label1_Click y

---

Code:

---

'set up necessary variables
Dim bitGroup(0 To 4) As Long
x = 0
i = 0
tmp = HighBit

' If first move go for a block
If UBound(Os, 2) = 0 Then GoTo Defense


'we Previously sorted moves by most winnable (least moves to win) to least winnable
'If defense has advantage choose defense
If Os(max, 1) > Xs(max, 1) Then GoTo Defense
   
Offense:
    'construct bit image
    'convert 5X5 array to 1X5 for analysis
    Do While tmp
        If (Os(bmask, 1) And tmp) > 0 Then
            If (Os(bits, 1) And tmp) > 0 Then
                bitGroup(i) = x + 1 '
                i = i + 1
            Else
                bitGroup(i) = -(x + 1)
                i = i + 1
            End If
        End If
        x = x + 1
        tmp = Int(tmp / 2)
    Loop
    'place new piece adjacent to existing
    'check for adjacency
    For i = 0 To 3
       
        If (Sgn(bitGroup(i)) <> Sgn(bitGroup(i + 1))) Then
            If bitGroup(i) > 0 Then
                x = bitGroup(i) - 1
            Else
                x = bitGroup(i + 1) - 1
            End If
        End If
    Next
'convert move to cartesian coordinat 
    y = (Os(Cy, 1) + (x Mod 5)) * 19 + (Os(Cx, 1) + Int(x / 5))
   
    'click it
    Label1_Click y
    Exit Sub

'repeat same logic for defense
Defense:
    'construct bit image
   
    Do While tmp
        If (Xs(bmask, 1) And tmp) > 0 Then
            If (Xs(bits, 1) And tmp) > 0 Then
                bitGroup(i) = x + 1 '
                i = i + 1
            Else
                bitGroup(i) = -(x + 1)
                i = i + 1
            End If
        End If
        x = x + 1
        tmp = Int(tmp / 2)
    Loop
   
    'check for adjacency
    For i = 0 To 3
       
        If (Sgn(bitGroup(i)) <> Sgn(bitGroup(i + 1))) Then
            If bitGroup(i) > 0 Then
                x = bitGroup(i) - 1
            Else
                x = bitGroup(i + 1) - 1
            End If
        End If
    Next
   
    y = (Xs(Cy, 1) + (x Mod 5)) * 19 + (Xs(Cx, 1) + Int(x / 5))

    'click it
    Label1_Click y

---

any way to make my forms look fancy or something like that?

You can use Pictures in your backgrounds and make your buttons graphical. Add a logo somewhere.

i have used a picture as a background and used an icon for project...how to make my buttons fancy.........

Welcome to Fancy Buttons Ltd.

In a project - add a UserControl
in the Usercontrol Code add this code:

Code:

---

'Property Variables:
Dim m_MaskPicture As Picture
Dim m_Picture As Picture
Dim m_DownPicture As Picture
Dim m_MaskDownPicture As Picture
'Event Declarations:
Public Event Click()

Private Sub UserControl_Click()
    RaiseEvent Click
End Sub

Private Sub UserControl_Initialize()
With UserControl
    .BackStyle = 0
    .MaskColor = 0
    Set m_MaskPicture = LoadPicture(App.Path & "\ButtonMask.bmp")
    Set .MaskPicture = m_MaskPicture
    Set m_Picture = LoadPicture(App.Path & "\ButtonUp.bmp")
    Set .Picture = m_Picture
    Set m_DownPicture = LoadPicture(App.Path & "\ButtonDn.bmp")
    Set m_MaskDownPicture = LoadPicture(App.Path & "\ButtonDnMask.bmp")
End With
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Set UserControl.Picture = m_DownPicture
Set UserControl.MaskPicture = m_MaskDownPicture
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Set UserControl.Picture = m_Picture
Set UserControl.MaskPicture = m_MaskPicture
End Sub

---

Now you'll need some button images - see attachment below.
Pay special attention on how I created the 3D illusion.

to use the control close it's design form and it will appear on the toolbar. Drag it into your project form. It has only 1 event - "Click" and you can put your code in there. start with

Code:

---

Private Sub UserControl1_Click()
MsgBox "click"
End Sub

---

for testing purposes.

Wow that's all Rob? Yup that's about it. Now go forth and improvise.
Post Edited I've added a round button - just change the file name.

thnx alot mate.!

hello mate..!

i am a bit confuse in gnome sorting part..how is it working in my program and how is it swapping around.

i found explaination on internet

It simply moves forward until something is out of order. When one is found, it swaps the element back until it is in its place. Then, it continues traversing from that point

could u plz explain it to me.......
thnx

Sure - I'm going to quote myself from a previous thread where I described the workings of a gnome sort:

Quote:

---

It's based on an analogy of a garden gnome who wants to sort flower pots sitting in a line from small to big.

He goes to the first two , if the smaller one is first, he's ok with it so he steps to his right. If the next two are not in order he switches them and takes 1 step back and starts again. When he reaches the end all the flower pots are sorted.

---

The key to the process is not the switch but the step back - all sorting in place has some form of recursion, the beauty of a gnome sort over a bubble sort ( another popular sort in place algorithm) is that it doesn't have to start at the beginning all the time - just 1 step back. Otherwise they're very similar.

Hope that helps.

i got that.....now im my program when i put two Xs close to each other, right? how does it know that "O" need to be put next to it so that X cant win. the sorting X and sorting O part of the coding....is it doing that?

When the winning (or loosing ) pattern has been identified (by sorting) the routine converts that pattern from a 5X5 matrix (2 dimensional) to a 1X5 matrix (one dimensional) to check for adjacency. it then puts the O next to an X to block that pattern from becoming winnable. Or is it has the advantage it does the same to increase the winnability (new word, I created it) of the pattern. Or to win if it's the last piece.

thnx alot...
and one more thing about patterns which are defind in loud routine...how were they made................u mentioned excel i think.......how?

key functions are BIN2DEC and DEC2HEX

thnx alot mate..!

hello mate......this AI player have done my heading could u plz have a look at it..........when player 1 wins it gives the same error that was giving before.....
i added nowinner as boolean .set it true when game start but when player 1 wins it gives an error....but when computer wins it doesnt.....i think the problem is when resetting the grid nowinner is not setting to true......plz have a look

I corrected all this once in a previous post, but you had a button to reset the game then.

You can't reset from the check routine. It creates a circular logic. To correct first rem all the stuff I remmed in this part of the check routine:

Code:

---

Winner:
    NoWinner = False
    '==========================Player 1==================================
    If turn = "X" Then
    MsgBox " Player 1 wins      ", vbInformation, "Gomoku"
   
    player1_score = player1_score + 1
    lbl_player1score.Caption = player1_score

'    For index = 0 To 360
'    Label1(index).Caption = ""
'    Next index
   
    End If
   
   
    '==========================Player 2==================================
    If turn = "O" Then
    MsgBox " Player 2 wins      ", vbInformation, "Gomoku"
   
    player2_score = player2_score + 1
    lbl_player2score.Caption = player2_score
'
'    For index = 0 To 360
'    Label1(index).Caption = ""
'    Next index
'
   
    End If
   
'    player1 = True
'    NoWinner = True
   
   

End Sub

---

Next Add this code to the bottom of the Label1_Click routine, right before the End Sub:

Code:

---

Skip:
    If NoWinner Then Exit Sub
    Dim i As Integer
    player1 = True
    NoWinner = True
    For i = 0 To 360
        Label1(i).Caption = ""
    Next

---

so there isn't any way then? i have to keep it like this then