Option Explicit
Dim Numeros(5) As Long
Dim Imagen(5) As String
Dim Descubiertas(5) As Long
Dim Tachadas(5) As Long
Dim ImagenReverso As String
Dim Seguir As Long
Dim Intentos As Long
Const MaxIntentos = 5
Private Sub Form_Load()
Dim F As Long
' definimos los ficheros de imagenes
Imagen(0) = "Imagen1.jpg"
Imagen(1) = "Imagen2.jpg"
Imagen(2) = "Imagen3.jpg"
ImagenReverso = "ImagenReverso.jpg"
Command1.Caption = "Nueva Partida" ' ponemos el titulo del boton
For F = 0 To 5
Image1(F).Stretch = True ' esto sirve para que la imagen se adapte al recuadro del control Image
Next F
Randomize Timer
' comenzamos una nueva partida
NuevaPartida
End Sub
Private Sub NuevaPartida()
Dim F As Long
Dim F2 As Long
Dim Numero As Long
' cargamos los valores aleatorios de alguna manera...
For F = 0 To 5
Numeros(F) = 0
Next F
For F = 1 To 2
Repite:
Numero = Int(Rnd * 6)
If Numeros(Numero) = 0 Then
Numeros(Numero) = 0
Else
GoTo Repite
End If
Next F
For F = 1 To 2
Repite2:
Numero = Int(Rnd * 6)
If Numeros(Numero) = 0 Then
Numeros(Numero) = 1
Else
GoTo Repite2
End If
Next F
For F = 1 To 2
Repite3:
Numero = Int(Rnd * 6)
If Numeros(Numero) = 0 Then
Numeros(Numero) = 2
Else
GoTo Repite3
End If
Next F
' inicializamos
Intentos = 0
Seguir = -1
For F = 0 To 5
Image1(F).Enabled = True
Image1(F).Picture = LoadPicture(ImagenReverso) ' cargamos los reversos de las cartas
Descubiertas(F) = 0 ' todas estan sin descubrir
Tachadas(F) = 0 ' no hay parejas tachadas
Next F
End Sub
Private Sub Image1_Click(Index As Integer)
' al hacer click
Static EnUso As Long
Dim F As Long
Dim Contador As Long
' si la imagen esta descubierta o tachada por haber encontrado la pareja no hacemos nada y salimos
If Descubiertas(Index) <> 0 Or Tachadas(Index) <> 0 Then Exit Sub
' si esta sin descubrir...
' si estamos en una pausa le metemos prisa a la sub EsperaMiliseg.
' si esta sub esta en uso o ya hemos vuelto a pinchar otra imagen salimos.
If EnUso = 1 Then
If Seguir = -1 Then Seguir = Index
Exit Sub
End If
' si no estaba en uso avisamos de que ahora si lo esta
EnUso = 1
' nos ponemos a la espera de otra pulsacion
Seguir = -1
' marcamos la imagen como descubierta
Descubiertas(Index) = 1
' cargamos la imagen que hay que mostrar
Image1(Index).Picture = LoadPicture(Imagen(Numeros(Index)))
' hacemos una pausa para que se muestre la imagen
EsperaMiliseg 1000
' comprobamos si hay parejas o hemos acabado
Comprobar
' y salimos
EnUso = 0
' si le metimos prisa a la pausa era porque habiamos pinchado
' en una imagen, asi que pinchamos la imagen de nuevo
If Seguir <> -1 Then
Image1_Click (Seguir)
Seguir = -1
End If
End Sub
Sub EsperaMiliseg(ByVal Tiempo As Double)
Dim HoraActual As Double
On Local Error Resume Next
Seguir = -1
HoraActual = Timer
Do Until (Timer >= HoraActual + (Tiempo / 1000)) Or (Seguir = 1)
DoEvents
Loop
On Local Error GoTo 0
End Sub
Private Sub Comprobar()
Dim F As Long
Dim Pic1 As Long
Dim Contador As Long
Pic1 = -1
For F = 0 To 5
' si una imagen esta descubierta y no esta tachada por haber encontrado ya pareja...
If Descubiertas(F) <> 0 And Tachadas(F) = 0 Then
' la contamos...
Contador = Contador + 1
' y nos guardamos su indice.
If Pic1 = -1 Then
Pic1 = F
Else
' si ya tenemos guardado un indice, es que esta es la segunda carta descubierta.
' si las 2 cargas son iguales...
If Numeros(F) = Numeros(Pic1) Then
' las tachamos...
Tachadas(F) = 1
Tachadas(Pic1) = 1
' avisamos del acierto con un beep.
BeepAcierto
Else
' si son diferentes avisamos del fallo.
BeepFallo
End If
' y dejamos de buscar porque ya hemos encontrado 2 descubiertas.
Exit For
End If
End If
Next F
' comprobamos las descubiertas
For F = 0 To 5
If Descubiertas(F) = 0 Then Exit For
Next F
' si hemos descubieto ya todas las cartas hemos ganado
If F = 6 Then
MsgBox "Finalizado. Has ganado."
Else
' si no estan todas descubiertas...
If Contador = 2 Then
' contamos los intentos.
Intentos = Intentos + 1
' si ya has llegado al maximo de intentos pierdes
If Intentos = MaxIntentos Then
MsgBox "No te quedan intentos. Has perdido."
' deshabilitamos los Image para no seguir procesando ordenes.
For F = 0 To 5
Image1(F).Enabled = False
Next F
' y salimos.
GoTo FinSub
End If
' si no era el ultimo intento...
For F = 0 To 5
' volteamos las cartas que no estan tachadas y seguimos.
If Tachadas(F) = 0 Then
Image1(F) = LoadPicture(ImagenReverso)
Descubiertas(F) = 0
End If
Next F
End If
End If
FinSub:
End Sub
Private Sub BeepAcierto()
Beep
End Sub
Private Sub BeepFallo()
Beep
End Sub
Private Sub Command1_Click()
NuevaPartida
End Sub