Results 1 to 6 of 6

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

  1. #1

    Thread Starter
    PowerPoster Nightwalker83's Avatar
    Join Date
    Dec 2001
    Location
    Adelaide, Australia
    Posts
    13,344

    VB6.0 Tic Tac Toe/Noughts and Crosses

    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:
    1. Dim CLICKCOUNT, i, winner As Integer
    2.  
    3. Private Sub cmdExit_Click()
    4. 'Quit the game
    5. Unload Me
    6. End Sub
    7.  
    8. Private Sub cmdPlay_Click()
    9. 'Play the game
    10. Play
    11. End Sub
    12.  
    13. Private Sub cmdTile_Click(Index As Integer)
    14. If (CLICKCOUNT Mod 2 = 1) Then
    15. cmdTile(Index).Caption = "x"
    16. Else
    17. cmdTile(Index).Caption = "o"
    18. End If
    19. CLICKCOUNT = CLICKCOUNT + 1
    20. cmdTile(Index).Enabled = False
    21. CheckWinner
    22. End Sub
    23.  
    24. Private Sub Form_Load()
    25. 'Tic Tac Toe/Noughts and Crosses
    26. '14/04/2012
    27. 'Version 1.0
    28. 'Language VB6.0
    29. 'Author: Nightwalker83
    30. 'Website: http://aaronspehr.net/
    31. 'Version 1.0 11/04/2012 - Basic two player functions implemented.
    32. Me.Caption = "Tic Tac Toe/Noughts and Crosses"
    33. For i = 0 To 8
    34. cmdTile(i).Enabled = False
    35. Next i
    36. End Sub
    37.  
    38. Private Sub Play()
    39. CLICKCOUNT = 0
    40. winner = -1
    41. For i = 0 To 8
    42. cmdTile(i).Caption = ""
    43. cmdTile(i).Enabled = True
    44. Next i
    45. End Sub
    46.  
    47. Private Sub CheckWinner()
    48. ' Horizontal row 1
    49. If cmdTile(0).Caption = "o" And cmdTile(1).Caption = "o" And cmdTile(2).Caption = "o" Then winner = 0
    50. If cmdTile(0).Caption = "x" And cmdTile(1).Caption = "x" And cmdTile(2).Caption = "x" Then winner = 1
    51. ' Horizontal row 2
    52. If cmdTile(3).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(5).Caption = "o" Then winner = 2
    53. If cmdTile(3).Caption = "x" And cmdTile(4).Caption = "x" And cmdTile(5).Caption = "x" Then winner = 3
    54. ' Horizontal row 3
    55. If cmdTile(6).Caption = "o" And cmdTile(7).Caption = "o" And cmdTile(8).Caption = "o" Then winner = 4
    56. If cmdTile(6).Caption = "x" And cmdTile(7).Caption = "x" And cmdTile(8).Caption = "x" Then winner = 5
    57. 'Vertical row 1
    58. If cmdTile(0).Caption = "o" And cmdTile(3).Caption = "o" And cmdTile(6).Caption = "o" Then winner = 6
    59. If cmdTile(0).Caption = "x" And cmdTile(3).Caption = "x" And cmdTile(6).Caption = "x" Then winner = 7
    60. 'Vertical row 2
    61. If cmdTile(1).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(7).Caption = "o" Then winner = 8
    62. If cmdTile(1).Caption = "x" And cmdTile(4).Caption = "x" And cmdTile(7).Caption = "x" Then winner = 9
    63. 'Vertical row 3
    64. If cmdTile(2).Caption = "o" And cmdTile(5).Caption = "o" And cmdTile(8).Caption = "o" Then winner = 10
    65. If cmdTile(2).Caption = "x" And cmdTile(5).Caption = "x" And cmdTile(8).Caption = "x" Then winner = 11
    66. 'Diagonal 1
    67. If cmdTile(0).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(8).Caption = "o" Then winner = 12
    68. If cmdTile(0).Caption = "x" And cmdTile(4).Caption = "x" And cmdTile(8).Caption = "x" Then winner = 13
    69. 'Diagonal 2
    70. If cmdTile(2).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(6).Caption = "o" Then winner = 14
    71. If cmdTile(2).Caption = "x" And cmdTile(4).Caption = "x" And cmdTile(6).Caption = "x" Then winner = 15
    72. 'MsgBox (winner)
    73. 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
    74.      Result = MsgBox("Player o is victorious! Play Again?", vbYesNo)
    75.      If Result = vbYes Then
    76.      Play
    77.      Else
    78.      endGame
    79.      End If
    80.      End If
    81. 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
    82.      Result = MsgBox("Player x is victorious! Play Again?", vbYesNo)
    83.      If Result = vbYes Then
    84.      Play
    85.      Else
    86.      endGame
    87.      End If
    88.      End If
    89. If CLICKCOUNT = 9 Then
    90. MsgBox ("This game is a draw!")
    91. endGame
    92. End If
    93. End Sub
    94.  
    95. Private Sub endGame()
    96. For i = 0 To 8
    97. cmdTile(i).Enabled = False
    98. Next i
    99. End Sub

    Comments and suggestions welcome!


    Nightwalker
    Attached Files Attached Files
    Last edited by Nightwalker83; May 24th, 2012 at 04:05 AM. Reason: Adding more!
    when you quote a post could you please do it via the "Reply With Quote" button or if it multiple post click the "''+" button then "Reply With Quote" button.
    If this thread is finished with please mark it "Resolved" by selecting "Mark thread resolved" from the "Thread tools" drop-down menu.
    https://get.cryptobrowser.site/30/4111672

  2. #2

    Thread Starter
    PowerPoster Nightwalker83's Avatar
    Join Date
    Dec 2001
    Location
    Adelaide, Australia
    Posts
    13,344

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

    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.
    Last edited by Nightwalker83; Apr 18th, 2012 at 09:42 PM. Reason: Fixed spelling!
    when you quote a post could you please do it via the "Reply With Quote" button or if it multiple post click the "''+" button then "Reply With Quote" button.
    If this thread is finished with please mark it "Resolved" by selecting "Mark thread resolved" from the "Thread tools" drop-down menu.
    https://get.cryptobrowser.site/30/4111672

  3. #3

    Thread Starter
    PowerPoster Nightwalker83's Avatar
    Join Date
    Dec 2001
    Location
    Adelaide, Australia
    Posts
    13,344

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

    Here is the new version!

    vb Code:
    1. Dim CLICKCOUNT, i, Winner As Integer, Won As Boolean, Index As Integer, game As String, finished As Boolean, Retval As String
    2.  
    3. Private Sub cmdExit_Click()
    4. 'Quit the game
    5. Unload Me
    6. End Sub
    7.  
    8. Private Sub cmdPlay_Click()
    9. 'Play the game
    10. Play
    11. End Sub
    12.  
    13. Private Sub cmdTile_Click(Index As Integer)
    14. If game = vbNo Then
    15.  If (CLICKCOUNT Mod 2 = 1) Then
    16.   cmdTile(Index).Caption = "x"
    17.   Else
    18.   cmdTile(Index).Caption = "o"
    19.  End If
    20.    cmdTile(Index).Enabled = False
    21.    CLICKCOUNT = CLICKCOUNT + 1
    22.   CheckWinner
    23. Else
    24.   computer (Index)
    25. End If
    26. End Sub
    27. Private Sub computer(Index As Integer)
    28. 'Written by spoo of vbforums
    29. 'http://www.vbforums.com/showpost.php?p=4160166&postcount=14
    30.     nRun = nRun + 1
    31.    
    32.     ' set Player's tile
    33.       cmdTile(Index).Caption = Retval
    34.       cmdTile(Index).Enabled = False
    35.    
    36.     txtPlayer.Text = Trim(nRun) + "--" + Trim(Index) + vbCrLf
    37.     CheckWinner
    38.     If Won = False Then
    39.     ' set Computer's tile
    40.     Index = Int(8 * Rnd)
    41.     txtComputer.Text = Trim(nRun) + "--" + Trim(Index)
    42.     ' revise if "used"
    43.     If cmdTile(Index).Enabled = False Then
    44.         cmdTile(Index).BackColor = RGB(255, 255, 200)           ' lite yellow
    45.         For ii = 0 To 8
    46.             ' even this randomly selected Tile is "used"
    47.             If cmdTile(Index).Enabled = False Then
    48.                 Index = Int(8 * Rnd)
    49.                 cmdTile(Index).BackColor = RGB(220, 255, 255)   ' lite cyan
    50.                 txtComputer.Text = txtComputer.Text + Trim(Index)
    51.             ' ok now
    52.             Else
    53.                 txtComputer.Text = Trim(Index) + vbCrLf
    54.                 Exit For
    55.             End If
    56.         Next ii
    57.     End If
    58.      If Retval = "o" Then cmdTile(Index).Caption = "x"
    59.      If Retval = "x" Then cmdTile(Index).Caption = "o"
    60.     cmdTile(Index).Enabled = False
    61.     CLICKCOUNT = CLICKCOUNT + 2
    62.     CheckWinner
    63.     cmdExit.SetFocus
    64.     End If
    65. End Sub
    66. Private Sub Form_Load()
    67. 'Tic Tac Toe/Noughts and Crosses
    68. '14/04/2012
    69. 'Version 2.0
    70. 'Language VB6.0
    71. 'Author: Nightwalker83
    72. 'Website: http://aaronspehr.net/
    73. 'Version 1.0 11/04/2012 - Basic two player functions implemented.
    74. 'Version 2.0 14/04/2012 - Implemented player verse computer A.I game
    75. 'Version 2.1 21/05/2012 - Allows for player to choose their marker
    76. Me.Caption = "Tic Tac Toe/Noughts and Crosses"
    77. For i = 0 To 8
    78. cmdTile(i).Enabled = False
    79. Next i
    80. Won = False
    81. End Sub
    82.  
    83. Sub Play()
    84. finished = False
    85. Winner = -1
    86. For i = 0 To 8
    87. cmdTile(i).Caption = ""
    88. cmdTile(i).Enabled = True
    89. cmdTile(i).BackColor = vbWhite
    90. Next i
    91.   ' fill array with button text
    92.     ButtonText(0) = "Yes"
    93.     ButtonText(1) = "No"
    94.      game = MessageBox(Me.hwnd, "Do you want to play Single player a game?", vbYesNo, "Choose Player")
    95.    
    96.     ' fill array with button text
    97.     ButtonText(0) = "O"
    98.     ButtonText(1) = "X"
    99.     ButtonText(2) = "Cancel"
    100.            
    101.     'Display the box
    102.     Retval = MessageBox(Me.hwnd, "Choose whether you want to be player O or X", vbYesNoCancel, "Choose Player")
    103.    
    104.     Select Case Retval
    105.      Case 6
    106.         Retval = "o"
    107.      Case 7
    108.         Retval = "x"
    109.      Case 2
    110.         endGame
    111.     End Select
    112. End Sub
    113.  
    114. Private Sub CheckWinner()
    115. Dim cc
    116. cc = CLICKCOUNT
    117. ' Horizontal row 1
    118. If cmdTile(0).Caption = "o" And cmdTile(1).Caption = "o" And cmdTile(2).Caption = "o" Then Winner = 0
    119. If cmdTile(0).Caption = "x" And cmdTile(1).Caption = "x" And cmdTile(2).Caption = "x" Then Winner = 1
    120. ' Horizontal row 2
    121. If cmdTile(3).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(5).Caption = "o" Then Winner = 2
    122. If cmdTile(3).Caption = "x" And cmdTile(4).Caption = "x" And cmdTile(5).Caption = "x" Then Winner = 3
    123. ' Horizontal row 3
    124. If cmdTile(6).Caption = "o" And cmdTile(7).Caption = "o" And cmdTile(8).Caption = "o" Then Winner = 4
    125. If cmdTile(6).Caption = "x" And cmdTile(7).Caption = "x" And cmdTile(8).Caption = "x" Then Winner = 5
    126. 'Vertical row 1
    127. If cmdTile(0).Caption = "o" And cmdTile(3).Caption = "o" And cmdTile(6).Caption = "o" Then Winner = 6
    128. If cmdTile(0).Caption = "x" And cmdTile(3).Caption = "x" And cmdTile(6).Caption = "x" Then Winner = 7
    129. 'Vertical row 2
    130. If cmdTile(1).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(7).Caption = "o" Then Winner = 8
    131. If cmdTile(1).Caption = "x" And cmdTile(4).Caption = "x" And cmdTile(7).Caption = "x" Then Winner = 9
    132. 'Vertical row 3
    133. If cmdTile(2).Caption = "o" And cmdTile(5).Caption = "o" And cmdTile(8).Caption = "o" Then Winner = 10
    134. If cmdTile(2).Caption = "x" And cmdTile(5).Caption = "x" And cmdTile(8).Caption = "x" Then Winner = 11
    135. 'Diagonal 1
    136. If cmdTile(0).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(8).Caption = "o" Then Winner = 12
    137. If cmdTile(0).Caption = "x" And cmdTile(4).Caption = "x" And cmdTile(8).Caption = "x" Then Winner = 13
    138. 'Diagonal 2
    139. If cmdTile(2).Caption = "o" And cmdTile(4).Caption = "o" And cmdTile(6).Caption = "o" Then Winner = 14
    140. If cmdTile(2).Caption = "x" And cmdTile(4).Caption = "x" And cmdTile(6).Caption = "x" Then Winner = 15
    141. 'MsgBox (winner)
    142. 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
    143.      Won = True
    144.      finished = True
    145.      O = MsgBox("Player o is victorious! Play Again?", vbYesNo)
    146.      If O = vbYes Then
    147.      Randomize
    148.      resetcount
    149.      Play
    150.      Else
    151.      endGame
    152.      End If
    153.      End If
    154. 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
    155.          Won = True
    156.          finished = True
    157.      X = MsgBox("Player x is victorious! Play Again?", vbYesNo)
    158.      If X = vbYes Then
    159.      Randomize
    160.      resetcount
    161.      Play
    162.      Else
    163.      endGame
    164.      End If
    165.      End If
    166.      Me.Caption = cc
    167. If result = vbYes And cc = 9 And Won = False Then
    168. finished = True
    169. draw
    170. endGame
    171. End If
    172. If result = vbNo And cc >= 10 And Won = False Then
    173. finished = True
    174. draw
    175. endGame
    176. End If
    177. End Sub
    178.  
    179. Private Sub endGame()
    180. For i = 0 To 8
    181. cmdTile(i).Enabled = False
    182. Next i
    183. End Sub
    184.  
    185. Private Sub draw()
    186. MsgBox ("This game is a draw!")
    187. End Sub
    188.  
    189. Private Sub resetcount()
    190. CLICKCOUNT = 0
    191. cc = 0
    192. txtPlayer.Text = ""
    193. txtComputer.Text = ""
    194. Form_Load
    195. End Sub

    Edit:

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

    Module code:
    vb Code:
    1. Option Explicit
    2.  
    3. 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
    4. Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    5. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    6. Private Declare Function GetCurrentThreadId Lib "KERNEL32" () As Long
    7. 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
    8.  
    9.  ' used for locating and changing the buttons
    10. 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
    11. Private Declare Function SetWindowText Lib "user32.dll" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    12. Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    13.  
    14.  
    15. Const GWL_HINSTANCE = (-6)
    16. Const HCBT_ACTIVATE = 5
    17. Const WH_CBT = 5
    18.  
    19. Type RECT
    20.     left As Long
    21.     top As Long
    22.     Right As Long
    23.     Bottom As Long
    24. End Type
    25.  
    26. Dim hHook As Long
    27. Dim parenthWnd As Long
    28.  
    29. Public ButtonText(0 To 3) As String
    30.  
    31. Public Function MessageBox(ByVal hwnd As Long, ByVal Prompt As String, Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, _
    32.                     Optional ByVal Title As String = "", Optional ByVal HelpFile As String, Optional ByVal Context, _
    33.                     Optional ByVal centerForm As Boolean = True) As VbMsgBoxResult
    34. Dim ret As Long
    35.  
    36.     Dim hInst As Long
    37.     Dim Thread As Long
    38.     'Set up the CBT hook
    39.     parenthWnd = hwnd
    40.    
    41.     hInst = GetWindowLong(hwnd, GWL_HINSTANCE)
    42.     Thread = GetCurrentThreadId()
    43.     hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProcCenterForm, hInst, Thread)
    44.        
    45.     ret = MessageBoxEx(hwnd, Prompt, Title, Buttons, 0)
    46.     MessageBox = ret
    47. End Function
    48.  
    49. Private Function WinProcCenterForm(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    50. Dim Btn(0 To 3) As Long
    51. Dim ButtonCount As Integer
    52. Dim T As Integer
    53.    
    54.     If lMsg = HCBT_ACTIVATE Then
    55.  
    56.         Btn(0) = FindWindowEx(wParam, 0, vbNullString, vbNullString)
    57.  
    58.         Dim cName As String, Length As Long
    59.         For T = 1 To 3
    60.             Btn(T) = FindWindowEx(wParam, Btn(T - 1), vbNullString, vbNullString)
    61.             ' no more windows found
    62.             If Btn(T) = 0 Then Exit For
    63.         Next T
    64.  
    65.         For T = 0 To 3
    66.             If Btn(T) <> 0 And Btn(T) <> wParam Then
    67.                 cName = Space(255)
    68.                 Length = GetClassName(Btn(T), cName, 255)
    69.                 cName = left(cName, Length)
    70.                 Debug.Print cName
    71.                 If UCase(cName) = "BUTTON" Then
    72.                     ' a button
    73.                     SetWindowText Btn(T), ButtonText(ButtonCount)
    74.                     ButtonCount = ButtonCount + 1
    75.                 End If
    76.             End If
    77.         Next T
    78.  
    79.         UnhookWindowsHookEx hHook
    80.      End If
    81.      WinProcCenterForm = False
    82. End Function
    Last edited by Nightwalker83; May 24th, 2012 at 06:46 PM. Reason: Adding more!
    when you quote a post could you please do it via the "Reply With Quote" button or if it multiple post click the "''+" button then "Reply With Quote" button.
    If this thread is finished with please mark it "Resolved" by selecting "Mark thread resolved" from the "Thread tools" drop-down menu.
    https://get.cryptobrowser.site/30/4111672

  4. #4
    Registered User
    Join Date
    Mar 2014
    Posts
    1

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

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

  5. #5

    Thread Starter
    PowerPoster Nightwalker83's Avatar
    Join Date
    Dec 2001
    Location
    Adelaide, Australia
    Posts
    13,344

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

    Quote Originally Posted by tabtabs350 View Post
    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?
    when you quote a post could you please do it via the "Reply With Quote" button or if it multiple post click the "''+" button then "Reply With Quote" button.
    If this thread is finished with please mark it "Resolved" by selecting "Mark thread resolved" from the "Thread tools" drop-down menu.
    https://get.cryptobrowser.site/30/4111672

  6. #6

    Thread Starter
    PowerPoster Nightwalker83's Avatar
    Join Date
    Dec 2001
    Location
    Adelaide, Australia
    Posts
    13,344

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

    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"
    Last edited by Nightwalker83; Mar 25th, 2014 at 08:12 PM. Reason: Adding more!
    when you quote a post could you please do it via the "Reply With Quote" button or if it multiple post click the "''+" button then "Reply With Quote" button.
    If this thread is finished with please mark it "Resolved" by selecting "Mark thread resolved" from the "Thread tools" drop-down menu.
    https://get.cryptobrowser.site/30/4111672

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width