Código:
Private Sub Form_Load()
'
' TA-TE-TI Simple
' por Arielo
' para Monografias.com
'
' Código de libre distribución y/o modificación
'
'
' Esta subrutina, es lo primero que se ejecuta al empezar a jugar
'
Call JuegoNuevo
End Sub
Sub JuegoNuevo()
'
' Esta subrutina se usa para inicializar el tablero.
'
Randomize Timer
' Inicializa el tablero
For i = 0 To 8
lblCasilla(i).Tag = 0
lblCasilla(i).Caption = ""
Next
' Indica Quién jugará primero: la pc o el jugador
Tur = Rnd
If Tur > 0.5 Then
lblTurno.Tag = 1
lblTurno.Caption = "O - P.C."
Call JuegaPC
Else
lblTurno.Tag = 0
lblTurno.Caption = "X - JUGADOR"
End If
End Sub
Private Sub lblCasilla_Click(Index As Integer)
'
' Esta subrutina, corresponde a la jugada del jugador humano.
' Se activa cuando éste hace clic en una casilla del tablero.
'
' Controla que sea realmente el turno del jugador
If lblTurno.Tag = 1 Then
a = MsgBox("No es tu turno...", , "Error")
Exit Sub
End If
' Controla que la casilla elegida, esté vacía
If lblCasilla(Index).Tag <> 0 Then
a = MsgBox("La casilla ya está siendo usada", , "Error")
Exit Sub
End If
' Si está todo bien, coloca una "X" roja en la casilla
lblCasilla(Index).ForeColor = RGB(255, 60, 60) ' Indica que el color de las letras, es rojizo
lblCasilla(Index).Caption = "X" ' Coloca la Equis en el tablero
lblCasilla(Index).Tag = 10 ' Indica que la casilla está ocupada por una ficha del jugador
' Controla si el jugador hizo tateti
For i = 1 To 8
Call SumaLinea(i, ValorLinea, Cas1, Cas2, Cas3)
If ValorLinea = 30 Then
' Si el jugador hizo tateti, lo anuncia...
a = MsgBox("Fin del juego... Ganaste!!!!", , "Final")
' ... suma 1 punto a los partidos ganados por el jugador...
lblGanados = Val(lblGanados.Caption) + 1
' ... reinicia el tablero ...
Call JuegoNuevo
' ... y sale, para comenzar con el nuevo juego...
Exit Sub
End If
Next
' Cambia el turno. Ahora le toca jugar a la PC
lblTurno = "O - P.C."
lblTurno.Tag = 1
Call JuegaPC
' Controla si no se ha llegado a un empate
Call ControlaEmpates
End Sub
Sub JuegaPC()
'
' Esta subrutina, toma la decisión acerca de qué casilla jugará la PC en su turno.
'
' Primero, se fija si puede hacer TaTeTi
For i = 1 To 8
Call SumaLinea(i, ValorLinea, Cas1, Cas2, Cas3)
If ValorLinea = 200 Then ' Indica que la PC puede hacer tateti, porque tiene dos fichas en línea
' Analiza cuál de las tres casillas de la línea, es la que está libre, y decide jugar esa.
If lblCasilla(Cas1).Tag = 0 Then CasillaJugada = Cas1
If lblCasilla(Cas2).Tag = 0 Then CasillaJugada = Cas2
If lblCasilla(Cas3).Tag = 0 Then CasillaJugada = Cas3
End If
Next
If CasillaJugada > 0 Then
GoTo UbicaFicha ' Ya decidió que jugará esta casilla, para ganar el partido
End If
' Se fija si el jugador está a punto de hacer TaTeTi
For i = 1 To 8
Call SumaLinea(i, ValorLinea, Cas1, Cas2, Cas3)
If ValorLinea = 20 Then ' Indica que el jugador está a punto de hacer tateti
If lblCasilla(Cas1).Tag = 0 Then CasillaJugada = Cas1
If lblCasilla(Cas2).Tag = 0 Then CasillaJugada = Cas2
If lblCasilla(Cas3).Tag = 0 Then CasillaJugada = Cas3
End If
Next
If CasillaJugada > 0 Then
GoTo UbicaFicha
Else
' Debido a que no puede hacer tateti, y no hay peligro de que el jugador lo haga, juega una casilla al azar
Do
CasillaJugada = Int(Rnd * 9) ' Elije una casilla al azar
Loop Until lblCasilla(CasillaJugada).Tag = 0 ' Elegirá casillas al azar, hasta que encuentre una sin ocupar
End If
' Acá, la PC coloca la ficha en la casilla que eligió...
UbicaFicha:
lblCasilla(CasillaJugada).ForeColor = RGB(60, 60, 255) ' Indica que el color de las letras, es azulado
lblCasilla(CasillaJugada).Caption = "O" ' Coloca el círculo en el tablero
lblCasilla(CasillaJugada).Tag = 100 ' Indica que la casilla está ocupada por una ficha del PC
' Controla que con su jugada no se haya llegado a un empate...
Call ControlaEmpates
' Controla si la computadora hizo tateti
For i = 1 To 8
Call SumaLinea(i, ValorLinea, Cas1, Cas2, Cas3)
If ValorLinea = 300 Then
' Si la PC hizo tateti, muestra el cartel anunciándolo...
a = MsgBox("Fin del juego... Perdiste!!!!", , "Final")
'... suma 1 a los partidos perdidos por el jugador...
lblPerdidos = Val(lblPerdidos.Caption) + 1
'... reinicia el tablero...
Call JuegoNuevo
'... y sale, para comenzar el nuevo juego...
Exit Sub
End If
Next
' Le devuelve el turno al jugador, y sale de la subrutina
lblTurno = "X - JUGADOR"
lblTurno.Tag = 0
End Sub
Sub ControlaEmpates()
'
' En esta subrutina, se controla si se colocaron todas las fichas posibles
' Si es así, ha habido un empate...
'
Empate = 1
For i = 0 To 8
If lblCasilla(i).Tag = 0 Then Empate = 0
Next
If Empate = 1 Then
a = MsgBox("Fin del juego... Empate!!!", , "Final")
lblEmpates = Val(lblEmpates.Caption) + 1
Call JuegoNuevo
Exit Sub
End If
End Sub
Sub SumaLinea(Numero, ValorLinea, Cas1, Cas2, Cas3)
'
' En esta rutina, se controla qué hay ubicado en las casillas que conforman cada una de las líneas
' en las que es posible hacer TaTeTi
'
Select Case Numero
Case Is = 1: Cas1 = 0: Cas2 = 1: Cas3 = 2 ' Primera línea horizontal
Case Is = 2: Cas1 = 3: Cas2 = 4: Cas3 = 5 ' Segunda línea horizontal
Case Is = 3: Cas1 = 6: Cas2 = 7: Cas3 = 8 ' Tercera línea horizontal
Case Is = 4: Cas1 = 0: Cas2 = 3: Cas3 = 6 ' Primera columna vertical
Case Is = 5: Cas1 = 1: Cas2 = 4: Cas3 = 7 ' Segunda columna vertical
Case Is = 6: Cas1 = 2: Cas2 = 5: Cas3 = 8 ' Tercera columna vertical
Case Is = 7: Cas1 = 0: Cas2 = 4: Cas3 = 8 ' Diagonal ARR_IZQ hasta ABA_DER
Case Is = 8: Cas1 = 2: Cas2 = 4: Cas3 = 6 ' Diagonal ARR_DER hasta ABA_IZQ
End Select
ValorLinea = Val(lblCasilla(Cas1).Tag) + Val(lblCasilla(Cas2).Tag) + Val(lblCasilla(Cas3).Tag)
End Sub
Marcadores