VBA - Jeu du Morpion (Tic Tac Toe)

Novembre 2017



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

A voir également


Publié par pijaku.
Ce document intitulé «  VBA - Jeu du Morpion (Tic Tac Toe)  » issu de CommentCaMarche (www.commentcamarche.net) est mis à disposition sous les termes de la licence Creative Commons. Vous pouvez copier, modifier des copies de cette page, dans les conditions fixées par la licence, tant que cette note apparaît clairement.