VB6.0 Tic Tac Toe/Noughts and Crosses

**Nightwalker83** · Apr 11th, 2012, 01:54 AM

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

VB Code:

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** · Apr 16th, 2012, 06:52 PM

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** · May 24th, 2012, 04:04 AM

Here is the new version!

vb Code:

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:

vb 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

**tabtabs350** · Mar 15th, 2014, 06:26 PM

Hi, I need help regarding to this. Is it possible to add a data base on this program? Specifically a LeaderBoard?

**Nightwalker83** · Mar 16th, 2014, 05:14 AM

Originally Posted by tabtabs350

Hi, I need help regarding to this. Is it possible to add a data base on this program? Specifically a LeaderBoard?

Sure it is! Which database are you thinking of using?

**Nightwalker83** · Mar 23rd, 2014, 11:17 PM

Here is the code for the latest version! Just download version 2.0 and replace the form code with the below code.

Code:

Dim CLICKCOUNT, i, Winner As Integer, Won As Boolean, Index As Integer, game As String, finished As Boolean, Retval As String
'Add reference to project for Microsoft ActiveX Data Object 6.1
Dim WithEvents cn As ADODB.Connection, rs As ADODB.Recordset   'this is the connection object
Dim XWin As Integer, OWin As Integer, Draw As Integer, ScoreHolder As Integer, Update As Boolean, nRun As Integer, cc As Integer
Dim strMessage 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)
Dim ii 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_Activate()
 Me.BorderStyle = 1
 Me.Caption = "Tic Tac Toe/Noughts and Crosses"
 XWin = 0
 OWin = 0
 Draw = 0
End Sub

Private Sub Form_Load()
'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
'Version 3.0 24/03/2014 - Added basic sql database saving for scores
 cmdPlay.Enabled = False
 dbConnect
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 O As VbMsgBoxResult, X As VbMsgBoxResult, result As VbMsgBoxResult
 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)
       OWin = OWin + 1
      ScoreHolder = OWin
      score
     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)
     XWin = XWin + 1
     ScoreHolder = XWin
     score
     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
     DrawnGame
      Draw = Draw + 1
      ScoreHolder = Draw
      score
     endGame
End If
     If result = vbNo And cc >= 10 And Won = False Then
      finished = True
      DrawnGame
      Draw = Draw + 1
      ScoreHolder = Draw
      score
      endGame
     End If
End Sub

Private Sub endGame()
 For i = 0 To 8
  cmdTile(i).Enabled = False
 Next i
End Sub

Private Sub DrawnGame()
 MsgBox ("This game is a draw!")
End Sub

Private Sub resetcount()
 CLICKCOUNT = 0
 cc = 0
 txtPlayer.Text = ""
 txtComputer.Text = ""
 Form_Load
End Sub

Private Sub score()
 rs.Find "PlayerID like '" & Retval & "'"
 rs.Fields("PlayerID") = Retval
 rs.Fields("Score") = ScoreHolder
 rs.Update 'Handle the data
End Sub

Private Sub dbConnect()
 Dim Table As String, DB As String
  Table = "PlayerScore"
  DB = "TicTacToe"
  Update = False
    'instantiate the connection object
    'LocalHost
    Set cn = New ADODB.Connection
  ConnectionString = "DRIVER={MySQL ODBC 3.51 Driver};" & _
  "server=127.0.0.1;" & _
  "database=TicTacToe;" & _
 "Option=3;" & _
 "port=3306;" & _
 "uid=root;"
 On Error GoTo server
 cn.Open ConnectionString 'open the connection
  
 'instantiate the recordset object
    Set rs = New ADODB.Recordset
    'open the recordset
    With rs
        .CursorLocation = adUseClient
        .Open Table, cn, adOpenKeyset, adLockOptimistic, adCmdTable
           If rs.RecordCount < 2 Then
               FieldExists rs, "PlayerID"
               FieldExists rs, "Score"
               If Rtn = False Then MsgBox "Please setup the database first!"
                Exit Sub
             End If
                .MoveNext
        If .EOF Then
            .MoveFirst
        Else
            .MoveLast
        End If
         For i = 0 To 8
          cmdTile(i).Enabled = False
         Next i
         End With
         Won = False
         If Not rs.Fields("Score") = "" Then ScoreHolder = rs.Fields("Score")
         cmdPlay.Enabled = True
         Exit Sub

server:
MsgBox "Please start the database server!"
End Sub

Public Function FieldExists(ByVal rsRecSet As ADODB.Recordset, ByVal FieldName As String) As Boolean
    Dim fld As ADODB.Field
    Dim Rtn As Boolean
     'Check to see if the correct fields and values are in the database
    If Not rsRecSet Is Nothing Then
        For Each fld In rsRecSet.Fields
            If StrComp(fld.Name, FieldName, vbTextCompare) = 0 Then
                Rtn = True
                Exit For
            End If
        Next fld
    End If

    FieldExists = Rtn

End Function

Edit:

You will also need to include a module with the code from post #3 in it.

Edit II:

To change it so you are using an Access database to save rather than an sql database change the connect string from:

Code:

  ConnectionString = "DRIVER={MySQL ODBC 3.51 Driver};" & _
  "server=127.0.0.1;" & _
  "database=TicTacToe;" & _
 "Option=3;" & _
 "port=3306;" & _
 "uid=root;"

to

Code:

    cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                          "Data Source=" & App.Path & "\Customers.mdb"

Thread: VB6.0 Tic Tac Toe/Noughts and Crosses

Thread Tools

Display

VB6.0 Tic Tac Toe/Noughts and Crosses

Re: VB6.0 Tic Tac Toe/Noughts and Crosses

Re: VB6.0 Tic Tac Toe/Noughts and Crosses

Re: VB6.0 Tic Tac Toe/Noughts and Crosses

Re: VB6.0 Tic Tac Toe/Noughts and Crosses

Re: VB6.0 Tic Tac Toe/Noughts and Crosses

Posting Permissions