VB6.0 Tic Tac Toe/Noughts and Crosses

[Nightwalker83]

Hi,

This is a little game of Tic Tac Toe aka Noughts and Crosses that I tried rewriting in VB6.0 from JAVA.

Change log:

Tic Tac Toe/Noughts and Crosses
Language VB6.0
Author: Nightwalker83
'Website: http://aaronspehr.net/
Version 1.0 11/04/2012 - Basic two player functions implemented.
Version 2.0 14/04/2012 - Implemented player verse computer A.I game
Version 2.1 21/05/2012 - Allows for player to choose their marker

Dim CLICKCOUNT, i, winner As Integer
 
Private Sub cmdExit_Click()
'Quit the game
Unload Me
End Sub
 
Private Sub cmdPlay_Click()
'Play the game
Play
End Sub
 
Private Sub cmdTile_Click(Index As Integer)
If (CLICKCOUNT Mod 2 = 1) Then
cmdTile(Index).Caption = "x"
Else
cmdTile(Index).Caption = "o"
End If
CLICKCOUNT = CLICKCOUNT + 1
cmdTile(Index).Enabled = False
CheckWinner
End Sub
 
Private Sub Form_Load()
'Tic Tac Toe/Noughts and Crosses
'14/04/2012
'Version 1.0
'Language VB6.0
'Author: Nightwalker83
'Website: http://aaronspehr.net/
'Version 1.0 11/04/2012 - Basic two player functions implemented.
Me.Caption = "Tic Tac Toe/Noughts and Crosses"
For i = 0 To 8
cmdTile(i).Enabled = False
Next i
End Sub
 
Private Sub Play()
CLICKCOUNT = 0
winner = -1
For i = 0 To 8
cmdTile(i).Caption = ""
cmdTile(i).Enabled = True
Next i
End Sub
 
Private Sub CheckWinner()
' Horizontal row 1
If cmdTile(0).Caption = "o" And cmdTile(1).Caption = "o" And cmdTile(2).Caption = "o" Then winner = 0
If cmdTile(0).Caption = "x" And cmdTile(1).Caption = "x" And cmdTile(2).Caption = "x" Then winner = 1
' Horizontal row 2
If cmdTile(3).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(5).Caption = "o" Then winner = 2
If cmdTile(3).Caption = "x" And cmdTile(4).Caption = "x" And cmdTile(5).Caption = "x" Then winner = 3
' Horizontal row 3
If cmdTile(6).Caption = "o" And cmdTile(7).Caption = "o" And cmdTile(8).Caption = "o" Then winner = 4
If cmdTile(6).Caption = "x" And cmdTile(7).Caption = "x" And cmdTile(8).Caption = "x" Then winner = 5
'Vertical row 1
If cmdTile(0).Caption = "o" And cmdTile(3).Caption = "o" And cmdTile(6).Caption = "o" Then winner = 6
If cmdTile(0).Caption = "x" And cmdTile(3).Caption = "x" And cmdTile(6).Caption = "x" Then winner = 7
'Vertical row 2
If cmdTile(1).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(7).Caption = "o" Then winner = 8
If cmdTile(1).Caption = "x" And cmdTile(4).Caption = "x" And cmdTile(7).Caption = "x" Then winner = 9
'Vertical row 3
If cmdTile(2).Caption = "o" And cmdTile(5).Caption = "o" And cmdTile(8).Caption = "o" Then winner = 10
If cmdTile(2).Caption = "x" And cmdTile(5).Caption = "x" And cmdTile(8).Caption = "x" Then winner = 11
'Diagonal 1
If cmdTile(0).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(8).Caption = "o" Then winner = 12
If cmdTile(0).Caption = "x" And cmdTile(4).Caption = "x" And cmdTile(8).Caption = "x" Then winner = 13
'Diagonal 2
If cmdTile(2).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(6).Caption = "o" Then winner = 14
If cmdTile(2).Caption = "x" And cmdTile(4).Caption = "x" And cmdTile(6).Caption = "x" Then winner = 15
'MsgBox (winner)
If (winner = 0 Or winner = 2 Or winner = 4 Or winner = 6 Or winner = 8 Or winner = 10 Or winner = 12 Or winner = 14) Then
     Result = MsgBox("Player o is victorious! Play Again?", vbYesNo)
     If Result = vbYes Then
     Play
     Else
     endGame
     End If
     End If
If (winner = 1 Or winner = 3 Or winner = 5 Or winner = 7 Or winner = 9 Or winner = 11 Or winner = 13 Or winner = 15) Then
     Result = MsgBox("Player x is victorious! Play Again?", vbYesNo)
     If Result = vbYes Then
     Play
     Else
     endGame
     End If
     End If
If CLICKCOUNT = 9 Then
MsgBox ("This game is a draw!")
endGame
End If
End Sub
 
Private Sub endGame()
For i = 0 To 8
cmdTile(i).Enabled = False
Next i
End Sub

Comments and suggestions welcome!


Nightwalker

[Nightwalker83]

I have uploaded version 2 to the above post, version two allows a player to play again the computer. Here is the discussion thread used to get the computer moves working.

[Nightwalker83]

Here is the new version!

Dim CLICKCOUNT, i, Winner As Integer, Won As Boolean, Index As Integer, game As String, finished As Boolean, Retval As String
 
Private Sub cmdExit_Click()
'Quit the game
Unload Me
End Sub
 
Private Sub cmdPlay_Click()
'Play the game
Play
End Sub
 
Private Sub cmdTile_Click(Index As Integer)
If game = vbNo Then
 If (CLICKCOUNT Mod 2 = 1) Then
  cmdTile(Index).Caption = "x"
  Else
  cmdTile(Index).Caption = "o"
 End If
   cmdTile(Index).Enabled = False
   CLICKCOUNT = CLICKCOUNT + 1
  CheckWinner
Else
  computer (Index)
End If
End Sub
Private Sub computer(Index As Integer)
'Written by spoo of vbforums
'http://www.vbforums.com/showpost.php?p=4160166&postcount=14
    nRun = nRun + 1
    
    ' set Player's tile
      cmdTile(Index).Caption = Retval
      cmdTile(Index).Enabled = False
    
    txtPlayer.Text = Trim(nRun) + "--" + Trim(Index) + vbCrLf
    CheckWinner
    If Won = False Then
    ' set Computer's tile
    Index = Int(8 * Rnd)
    txtComputer.Text = Trim(nRun) + "--" + Trim(Index)
    ' revise if "used"
    If cmdTile(Index).Enabled = False Then
        cmdTile(Index).BackColor = RGB(255, 255, 200)           ' lite yellow
        For ii = 0 To 8
            ' even this randomly selected Tile is "used"
            If cmdTile(Index).Enabled = False Then
                Index = Int(8 * Rnd)
                cmdTile(Index).BackColor = RGB(220, 255, 255)   ' lite cyan
                txtComputer.Text = txtComputer.Text + Trim(Index)
            ' ok now
            Else
                txtComputer.Text = Trim(Index) + vbCrLf
                Exit For
            End If
        Next ii
    End If
     If Retval = "o" Then cmdTile(Index).Caption = "x"
     If Retval = "x" Then cmdTile(Index).Caption = "o"
    cmdTile(Index).Enabled = False
    CLICKCOUNT = CLICKCOUNT + 2
    CheckWinner
    cmdExit.SetFocus
    End If
End Sub
Private Sub Form_Load()
'Tic Tac Toe/Noughts and Crosses
'14/04/2012
'Version 2.0
'Language VB6.0
'Author: Nightwalker83
'Website: http://aaronspehr.net/
'Version 1.0 11/04/2012 - Basic two player functions implemented.
'Version 2.0 14/04/2012 - Implemented player verse computer A.I game
'Version 2.1 21/05/2012 - Allows for player to choose their marker
Me.Caption = "Tic Tac Toe/Noughts and Crosses"
For i = 0 To 8
cmdTile(i).Enabled = False
Next i
Won = False
End Sub
 
Sub Play()
finished = False
Winner = -1
For i = 0 To 8
cmdTile(i).Caption = ""
cmdTile(i).Enabled = True
cmdTile(i).BackColor = vbWhite
Next i
  ' fill array with button text
    ButtonText(0) = "Yes"
    ButtonText(1) = "No"
     game = MessageBox(Me.hwnd, "Do you want to play Single player a game?", vbYesNo, "Choose Player")
    
    ' fill array with button text
    ButtonText(0) = "O"
    ButtonText(1) = "X"
    ButtonText(2) = "Cancel"
            
    'Display the box
    Retval = MessageBox(Me.hwnd, "Choose whether you want to be player O or X", vbYesNoCancel, "Choose Player")
    
    Select Case Retval
     Case 6
        Retval = "o"
     Case 7
        Retval = "x"
     Case 2
        endGame
    End Select
End Sub
 
Private Sub CheckWinner()
Dim cc
cc = CLICKCOUNT
' Horizontal row 1
If cmdTile(0).Caption = "o" And cmdTile(1).Caption = "o" And cmdTile(2).Caption = "o" Then Winner = 0
If cmdTile(0).Caption = "x" And cmdTile(1).Caption = "x" And cmdTile(2).Caption = "x" Then Winner = 1
' Horizontal row 2
If cmdTile(3).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(5).Caption = "o" Then Winner = 2
If cmdTile(3).Caption = "x" And cmdTile(4).Caption = "x" And cmdTile(5).Caption = "x" Then Winner = 3
' Horizontal row 3
If cmdTile(6).Caption = "o" And cmdTile(7).Caption = "o" And cmdTile(8).Caption = "o" Then Winner = 4
If cmdTile(6).Caption = "x" And cmdTile(7).Caption = "x" And cmdTile(8).Caption = "x" Then Winner = 5
'Vertical row 1
If cmdTile(0).Caption = "o" And cmdTile(3).Caption = "o" And cmdTile(6).Caption = "o" Then Winner = 6
If cmdTile(0).Caption = "x" And cmdTile(3).Caption = "x" And cmdTile(6).Caption = "x" Then Winner = 7
'Vertical row 2
If cmdTile(1).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(7).Caption = "o" Then Winner = 8
If cmdTile(1).Caption = "x" And cmdTile(4).Caption = "x" And cmdTile(7).Caption = "x" Then Winner = 9
'Vertical row 3
If cmdTile(2).Caption = "o" And cmdTile(5).Caption = "o" And cmdTile(8).Caption = "o" Then Winner = 10
If cmdTile(2).Caption = "x" And cmdTile(5).Caption = "x" And cmdTile(8).Caption = "x" Then Winner = 11
'Diagonal 1
If cmdTile(0).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(8).Caption = "o" Then Winner = 12
If cmdTile(0).Caption = "x" And cmdTile(4).Caption = "x" And cmdTile(8).Caption = "x" Then Winner = 13
'Diagonal 2
If cmdTile(2).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(6).Caption = "o" Then Winner = 14
If cmdTile(2).Caption = "x" And cmdTile(4).Caption = "x" And cmdTile(6).Caption = "x" Then Winner = 15
'MsgBox (winner)
If (Winner = 0 Or Winner = 2 Or Winner = 4 Or Winner = 6 Or Winner = 8 Or Winner = 10 Or Winner = 12 Or Winner = 14) Then
     Won = True
     finished = True
     O = MsgBox("Player o is victorious! Play Again?", vbYesNo)
     If O = vbYes Then
     Randomize
     resetcount
     Play
     Else
     endGame
     End If
     End If
If (Winner = 1 Or Winner = 3 Or Winner = 5 Or Winner = 7 Or Winner = 9 Or Winner = 11 Or Winner = 13 Or Winner = 15) Then
         Won = True
         finished = True
     X = MsgBox("Player x is victorious! Play Again?", vbYesNo)
     If X = vbYes Then
     Randomize
     resetcount
     Play
     Else
     endGame
     End If
     End If
     Me.Caption = cc
If result = vbYes And cc = 9 And Won = False Then
finished = True
draw
endGame
End If
If result = vbNo And cc >= 10 And Won = False Then
finished = True
draw
endGame
End If
End Sub
 
Private Sub endGame()
For i = 0 To 8
cmdTile(i).Enabled = False
Next i
End Sub
 
Private Sub draw()
MsgBox ("This game is a draw!")
End Sub
 
Private Sub resetcount()
CLICKCOUNT = 0
cc = 0
txtPlayer.Text = ""
txtComputer.Text = ""
Form_Load
End Sub

Edit:

I forgot to add the code to change the message box button captions.

Module code:

Option Explicit
 
Private Declare Function MessageBoxEx Lib "user32" Alias "MessageBoxExA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal uType As Long, ByVal wLanguageId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetCurrentThreadId Lib "KERNEL32" () As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
 
 ' used for locating and changing the buttons
Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Private Declare Function SetWindowText Lib "user32.dll" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
 
 
Const GWL_HINSTANCE = (-6)
Const HCBT_ACTIVATE = 5
Const WH_CBT = 5
 
Type RECT
    left As Long
    top As Long
    Right As Long
    Bottom As Long
End Type
 
Dim hHook As Long
Dim parenthWnd As Long
 
Public ButtonText(0 To 3) As String
 
Public Function MessageBox(ByVal hwnd As Long, ByVal Prompt As String, Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, _
                    Optional ByVal Title As String = "", Optional ByVal HelpFile As String, Optional ByVal Context, _
                    Optional ByVal centerForm As Boolean = True) As VbMsgBoxResult
Dim ret As Long
 
    Dim hInst As Long
    Dim Thread As Long
    'Set up the CBT hook
    parenthWnd = hwnd
    
    hInst = GetWindowLong(hwnd, GWL_HINSTANCE)
    Thread = GetCurrentThreadId()
    hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProcCenterForm, hInst, Thread)
        
    ret = MessageBoxEx(hwnd, Prompt, Title, Buttons, 0)
    MessageBox = ret
End Function
 
Private Function WinProcCenterForm(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim Btn(0 To 3) As Long
Dim ButtonCount As Integer
Dim T As Integer
    
    If lMsg = HCBT_ACTIVATE Then
 
        Btn(0) = FindWindowEx(wParam, 0, vbNullString, vbNullString)
 
        Dim cName As String, Length As Long
        For T = 1 To 3
            Btn(T) = FindWindowEx(wParam, Btn(T - 1), vbNullString, vbNullString)
            ' no more windows found
            If Btn(T) = 0 Then Exit For
        Next T
 
        For T = 0 To 3
            If Btn(T) <> 0 And Btn(T) <> wParam Then
                cName = Space(255)
                Length = GetClassName(Btn(T), cName, 255)
                cName = left(cName, Length)
                Debug.Print cName
                If UCase(cName) = "BUTTON" Then
                    ' a button
                    SetWindowText Btn(T), ButtonText(ButtonCount)
                    ButtonCount = ButtonCount + 1
                End If
            End If
        Next T
 
        UnhookWindowsHookEx hHook
     End If
     WinProcCenterForm = False
End Function