# VBForums CodeBank > Codebank - Game Programming >  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

VB Code:
Dim CLICKCOUNT, i, winner As Integer Private Sub cmdExit_Click()'Quit the gameUnload MeEnd Sub Private Sub cmdPlay_Click()'Play the gamePlayEnd Sub Private Sub cmdTile_Click(Index As Integer)If (CLICKCOUNT Mod 2 = 1) ThencmdTile(Index).Caption = "x"ElsecmdTile(Index).Caption = "o"End IfCLICKCOUNT = CLICKCOUNT + 1cmdTile(Index).Enabled = FalseCheckWinnerEnd 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 8cmdTile(i).Enabled = FalseNext iEnd Sub Private Sub Play()CLICKCOUNT = 0winner = -1For i = 0 To 8cmdTile(i).Caption = ""cmdTile(i).Enabled = TrueNext iEnd Sub Private Sub CheckWinner()' Horizontal row 1If cmdTile(0).Caption = "o" And cmdTile(1).Caption = "o" And cmdTile(2).Caption = "o" Then winner = 0If cmdTile(0).Caption = "x" And cmdTile(1).Caption = "x" And cmdTile(2).Caption = "x" Then winner = 1' Horizontal row 2If cmdTile(3).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(5).Caption = "o" Then winner = 2If cmdTile(3).Caption = "x" And cmdTile(4).Caption = "x" And cmdTile(5).Caption = "x" Then winner = 3' Horizontal row 3If cmdTile(6).Caption = "o" And cmdTile(7).Caption = "o" And cmdTile(8).Caption = "o" Then winner = 4If cmdTile(6).Caption = "x" And cmdTile(7).Caption = "x" And cmdTile(8).Caption = "x" Then winner = 5'Vertical row 1If cmdTile(0).Caption = "o" And cmdTile(3).Caption = "o" And cmdTile(6).Caption = "o" Then winner = 6If cmdTile(0).Caption = "x" And cmdTile(3).Caption = "x" And cmdTile(6).Caption = "x" Then winner = 7'Vertical row 2If cmdTile(1).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(7).Caption = "o" Then winner = 8If cmdTile(1).Caption = "x" And cmdTile(4).Caption = "x" And cmdTile(7).Caption = "x" Then winner = 9'Vertical row 3If cmdTile(2).Caption = "o" And cmdTile(5).Caption = "o" And cmdTile(8).Caption = "o" Then winner = 10If cmdTile(2).Caption = "x" And cmdTile(5).Caption = "x" And cmdTile(8).Caption = "x" Then winner = 11'Diagonal 1If cmdTile(0).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(8).Caption = "o" Then winner = 12If cmdTile(0).Caption = "x" And cmdTile(4).Caption = "x" And cmdTile(8).Caption = "x" Then winner = 13'Diagonal 2If cmdTile(2).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(6).Caption = "o" Then winner = 14If 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 IfIf (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 IfIf CLICKCOUNT = 9 ThenMsgBox ("This game is a draw!")endGameEnd IfEnd Sub Private Sub endGame()For i = 0 To 8cmdTile(i).Enabled = FalseNext iEnd 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!


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 gameUnload MeEnd Sub Private Sub cmdPlay_Click()'Play the gamePlayEnd 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  CheckWinnerElse  computer (Index)End IfEnd SubPrivate 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 IfEnd SubPrivate 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 markerMe.Caption = "Tic Tac Toe/Noughts and Crosses"For i = 0 To 8cmdTile(i).Enabled = FalseNext iWon = FalseEnd Sub Sub Play()finished = FalseWinner = -1For i = 0 To 8cmdTile(i).Caption = ""cmdTile(i).Enabled = TruecmdTile(i).BackColor = vbWhiteNext 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 SelectEnd Sub Private Sub CheckWinner()Dim cccc = CLICKCOUNT' Horizontal row 1If cmdTile(0).Caption = "o" And cmdTile(1).Caption = "o" And cmdTile(2).Caption = "o" Then Winner = 0If cmdTile(0).Caption = "x" And cmdTile(1).Caption = "x" And cmdTile(2).Caption = "x" Then Winner = 1' Horizontal row 2If cmdTile(3).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(5).Caption = "o" Then Winner = 2If cmdTile(3).Caption = "x" And cmdTile(4).Caption = "x" And cmdTile(5).Caption = "x" Then Winner = 3' Horizontal row 3If cmdTile(6).Caption = "o" And cmdTile(7).Caption = "o" And cmdTile(8).Caption = "o" Then Winner = 4If cmdTile(6).Caption = "x" And cmdTile(7).Caption = "x" And cmdTile(8).Caption = "x" Then Winner = 5'Vertical row 1If cmdTile(0).Caption = "o" And cmdTile(3).Caption = "o" And cmdTile(6).Caption = "o" Then Winner = 6If cmdTile(0).Caption = "x" And cmdTile(3).Caption = "x" And cmdTile(6).Caption = "x" Then Winner = 7'Vertical row 2If cmdTile(1).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(7).Caption = "o" Then Winner = 8If cmdTile(1).Caption = "x" And cmdTile(4).Caption = "x" And cmdTile(7).Caption = "x" Then Winner = 9'Vertical row 3If cmdTile(2).Caption = "o" And cmdTile(5).Caption = "o" And cmdTile(8).Caption = "o" Then Winner = 10If cmdTile(2).Caption = "x" And cmdTile(5).Caption = "x" And cmdTile(8).Caption = "x" Then Winner = 11'Diagonal 1If cmdTile(0).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(8).Caption = "o" Then Winner = 12If cmdTile(0).Caption = "x" And cmdTile(4).Caption = "x" And cmdTile(8).Caption = "x" Then Winner = 13'Diagonal 2If cmdTile(2).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(6).Caption = "o" Then Winner = 14If 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 IfIf (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 = ccIf result = vbYes And cc = 9 And Won = False Thenfinished = TruedrawendGameEnd IfIf result = vbNo And cc >= 10 And Won = False Thenfinished = TruedrawendGameEnd IfEnd Sub Private Sub endGame()For i = 0 To 8cmdTile(i).Enabled = FalseNext iEnd Sub Private Sub draw()MsgBox ("This game is a draw!")End Sub Private Sub resetcount()CLICKCOUNT = 0cc = 0txtPlayer.Text = ""txtComputer.Text = ""Form_LoadEnd 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 LongPrivate Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As LongPrivate Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As LongPrivate Declare Function GetCurrentThreadId Lib "KERNEL32" () As LongPrivate 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 buttonsPrivate 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 LongPrivate Declare Function SetWindowText Lib "user32.dll" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As LongPrivate 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 = 5Const WH_CBT = 5 Type RECT    left As Long    top As Long    Right As Long    Bottom As LongEnd Type Dim hHook As LongDim 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 VbMsgBoxResultDim 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 = retEnd Function Private Function WinProcCenterForm(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongDim Btn(0 To 3) As LongDim ButtonCount As IntegerDim 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 = FalseEnd Function

----------


## tabtabs350

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

----------


## Nightwalker83

> 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

Here is the code for the latest version! Just download version 2.0 and replace the form code with the below 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:



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

to



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

----------

