VBA: Morpion Game (Tic Tac Toe)


Esta é uma variante do grande clássico. Este é um jogo para ser jogado sozinho, contra o computador. Ele é fácil de ganhar pois há muito pouco de inteligência artificial. O jogo se passa na janela de execução do VBA (Ctrl + G no editor):

Option Explicit

Private Lines(1 To 3, 1 To 3) As String
Private Nb As Byte, Jogador As Byte
Private Ganha As Boolean, Fim As Boolean

Sub TicTacToe()
Dim P As String, CheatMode As Boolean, i&

    InitLines
    printLines Nb
    i = MsgBox("Você quer trapacear?", vbYesNo)
    CheatMode = (i <> vbYes)
    Do
        P = QuiJoue
        Debug.Print P & " joga"
        If P = "Humain" Then
            Call HumainJoue
            Ganha = IsWinner("X")
        Else
            Call OrdiJoue(CheatMode)
            Ganha = IsWinner("O")
        End If
        If Not Gagne Then Fim = IsEnd
    Loop Until Gagne Or Fim
    If Not Fim Then
        Debug.Print P & " Ganha!"
    Else
        Debug.Print "Game Over!"
    End If
End Sub

Sub InitLines(Optional S As String)
Dim i As Byte, j As Byte

    Nb = 0: Jogador = 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 "Vez 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 QuemJoga(Optional S As String) As String
    If Joueur = 0 Then
        Joueur = 1
        QuemJoga = "Humain"
    Else
        Jogador = 0
        QuemJoga = "Computador"
    End If
End Function

Sub HumainJoue(Optional S As String)
Dim L As Byte, C As Byte, BoaJogada As Boolean

    Do
        L = Application.InputBox("Escolha da linha", "Digital somente", Type:=1)
        If L > 0 And L < 4 Then
            C = Application.InputBox("Escolha da coluna", "Digital somente", 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
                    BoaJogada = True
                End If
            End If
        End If
    Loop Until BoaJogada
End Sub

Sub ComputadorJoga(booB As Boolean)
Dim L As Byte, C As Byte, BoaJogada 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
            BoaJogada = True
        End If
    Loop Until BoaJogada
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

Foto: © Microsoft.
Artigo original publicado por pijaku. Tradução feita por pintuda. Última modificação: 21 de fevereiro de 2018 às 14:57 por Pedro.CCM.
Este documento, intitulado 'VBA: Morpion Game (Tic Tac Toe)', está disponível sob a licença Creative Commons. Você pode copiar e/ou modificar o conteúdo desta página com base nas condições estipuladas pela licença. Não se esqueça de creditar o CCM (https://br.ccm.net/) ao utilizar este artigo.
Excel: contar ou adicionar células coloridas manualmente
VBA: como retornar valores múltiplos