Une variante du grand classique.
Jeu à jouer seul contre l'ordinateur.
Pas (ou très peu) d'Intelligence artificielle, victoire aisée!!
Le jeu se déroule dans la fenêtre d'exécution VBA (Ctrl+G sous l'éditeur)
Option Explicit
Private Lines(1 To 3, 1 To 3) As String
Private Nb As Byte, Joueur As Byte
Private Gagne As Boolean, Fin As Boolean
Sub TicTacToe()
Dim P As String, CheatMode As Boolean, i&
InitLines
printLines Nb
i = MsgBox("Voulez-vous tricher?", vbYesNo)
CheatMode = (i <> vbYes)
Do
P = QuiJoue
Debug.Print P & " joue"
If P = "Humain" Then
Call HumainJoue
Gagne = IsWinner("X")
Else
Call OrdiJoue(CheatMode)
Gagne = IsWinner("O")
End If
If Not Gagne Then Fin = IsEnd
Loop Until Gagne Or Fin
If Not Fin Then
Debug.Print P & " Gagne !"
Else
Debug.Print "Game Over!"
End If
End Sub
Sub InitLines(Optional S As String)
Dim i As Byte, j As Byte
Nb = 0: Joueur = 0
For i = LBound(Lines, 1) To UBound(Lines, 1)
For j = LBound(Lines, 2) To UBound(Lines, 2)
Lines(i, j) = "#"
Next j
Next i
End Sub
Sub printLines(Nb As Byte)
Dim i As Byte, j As Byte, strT As String
Debug.Print "Tour n° " & Nb
For i = LBound(Lines, 1) To UBound(Lines, 1)
For j = LBound(Lines, 2) To UBound(Lines, 2)
strT = strT & Lines(i, j)
Next j
Debug.Print strT
strT = vbNullString
Next i
End Sub
Function QuiJoue(Optional S As String) As String
If Joueur = 0 Then
Joueur = 1
QuiJoue = "Humain"
Else
Joueur = 0
QuiJoue = "Ordi"
End If
End Function
Sub HumainJoue(Optional S As String)
Dim L As Byte, C As Byte, BienJoue As Boolean
Do
L = Application.InputBox("Choix de la ligne", "Numérique uniquement", Type:=1)
If L > 0 And L < 4 Then
C = Application.InputBox("Choix de la colonne", "Numérique uniquement", Type:=1)
If C > 0 And C < 4 Then
If Lines(L, C) = "#" And Not Lines(L, C) = "X" And Not Lines(L, C) = "O" Then
Lines(L, C) = "X"
Nb = Nb + 1
printLines Nb
BienJoue = True
End If
End If
End If
Loop Until BienJoue
End Sub
Sub OrdiJoue(booB As Boolean)
Dim L As Byte, C As Byte, BienJoue As Boolean
If booB Then
For L = LBound(Lines, 1) To UBound(Lines, 1)
For C = LBound(Lines, 2) To UBound(Lines, 2)
If Lines(L, C) = "#" Then
Lines(L, C) = "O"
If IsWinner("O") Then
Lines(L, C) = "O"
Nb = Nb + 1
printLines Nb
Exit Sub
Else
Lines(L, C) = "#"
End If
End If
Next C
Next L
For L = LBound(Lines, 1) To UBound(Lines, 1)
For C = LBound(Lines, 2) To UBound(Lines, 2)
If Lines(L, C) = "#" Then
Lines(L, C) = "X"
If IsWinner("X") Then
Lines(L, C) = "O"
Nb = Nb + 1
printLines Nb
Exit Sub
Else
Lines(L, C) = "#"
End If
End If
Next C
Next L
End If
Randomize Timer
Do
L = Int((Rnd * 3) + 1)
C = Int((Rnd * 3) + 1)
If Lines(L, C) = "#" And Not Lines(L, C) = "X" And Not Lines(L, C) = "O" Then
Lines(L, C) = "O"
Nb = Nb + 1
printLines Nb
BienJoue = True
End If
Loop Until BienJoue
End Sub
Function IsWinner(S As String) As Boolean
Dim i As Byte, j As Byte, Ch As String, strTL As String, strTC As String
Ch = String(UBound(Lines, 1), S)
For i = LBound(Lines, 1) To UBound(Lines, 1)
For j = LBound(Lines, 2) To UBound(Lines, 2)
strTL = strTL & Lines(i, j)
strTC = strTC & Lines(j, i)
Next j
If strTL = Ch Or strTC = Ch Then IsWinner = True: Exit For
strTL = vbNullString: strTC = vbNullString
Next i
If Not IsWinner Then
strTL = Lines(1, 1) & Lines(2, 2) & Lines(3, 3)
strTC = Lines(1, 3) & Lines(2, 2) & Lines(3, 1)
If strTL = Ch Or strTC = Ch Then IsWinner = True
End If
End Function
Function IsEnd() As Boolean
Dim i As Byte, j As Byte
For i = LBound(Lines, 1) To UBound(Lines, 1)
For j = LBound(Lines, 2) To UBound(Lines, 2)
If Lines(i, j) = "#" Then Exit Function
Next j
Next i
IsEnd = True
End Function
Cet article est régulièrement mis à jour par des experts sous la direction de Jean-François Pillou, fondateur de CommentCaMarche et directeur délégué au développement numérique du groupe Figaro.
