
juego de memoria
Publicado por PEDRO (28 intervenciones) el 27/12/2012 20:52:47
He encontrado este juego de memoria (de parejas) y quiero añadirle un command para que el niño vea primero todas las imágenes y así tenga una idea de por donde están antes de empezar el juego. No soy capaz de hacerlo. ¿Podéis ayudarme?
Option Explicit
Dim archivos(200) As String
Dim totalarchivos As Integer
Dim facil(3) As Integer
Dim medio(15) As Integer
Dim dificil(23) As Integer
Dim Destapadas(23) As Integer
Dim findex, mindex, dindex, aindex As Integer
Dim Carta1, Carta2, UltimaCarta As Integer
Dim arreglo(3, 5) As Integer
Dim Pares As Integer
Dim Tbusuario As ADODB.Recordset
Dim Directorio_De_Imagenes As String
Dim i As Integer
Dim j As Integer
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Command4_Click()
Dim Tamaño(2) As Integer
Dim nAleatorio As Integer
If Option1.Value Then
Tamaño(1) = 2
Tamaño(2) = 2
End If
If Option2.Value Then
Tamaño(1) = 4
Tamaño(2) = 4
End If
If Option3.Value Then
Tamaño(1) = 4
Tamaño(2) = 6
End If
inicializar
For i = 0 To ((Tamaño(1) * Tamaño(2))) - 1
If Option1.Value Then picFondo(facil(i)).Visible = True
If Option2.Value Then picFondo(medio(i)).Visible = True
If Option3.Value Then picFondo(dificil(i)).Visible = True
Next i
For i = 0 To ((Tamaño(1) * Tamaño(2)) / 2) - 1
nAleatorio = Round(Rnd(aindex) * aindex)
BuscarUbicacion nAleatorio
archivos(nAleatorio) = archivos(aindex)
aindex = aindex - 1
Next i
End Sub
Sub inicializar()
Dim n As Integer
Dim i As Integer
Dim j As Integer
findex = 3
mindex = 15
dindex = 23
Carta1 = -1
Carta2 = -1
Pares = 0
For i = 0 To FilFondos.ListCount - 1
FilFondos.Selected(i) = True
archivos(i) = FilFondos.FileName
Next
totalarchivos = i - 1
aindex = totalarchivos
n = 0
For i = 0 To 3
For j = 0 To 5
arreglo(i, j) = n
TaparCarta n
Destapadas(n) = 0
n = n + 1
Next j
Next i
n = 0
For i = 0 To 1
For j = 0 To 1
facil(n) = arreglo(i, j)
n = n + 1
Next j
Next i
n = 0
For i = 0 To 3
For j = 0 To 3
medio(n) = arreglo(i, j)
n = n + 1
Next j
Next i
n = 0
For i = 0 To 3
For j = 0 To 5
dificil(n) = arreglo(i, j)
picFondo(n).Visible = False
n = n + 1
Next j
Next i
End Sub
Sub MostrarImagen(File As String, index)
Dim destWidth As Single, destHeight As Single
Dim destX As Single, destY As Single
Dim stepX As Single, stepY As Single
If Dir(Trim(Directorio_De_Imagenes) + "OBJETOS\" + File) <> "" And Trim(Directorio_De_Imagenes) + "OBJETOS\" + File <> "" Then
picSource.Picture = LoadPicture(Trim(Directorio_De_Imagenes) + "OBJETOS\" + File)
picFondo(index).Cls
' Ajustar Tamaño Toda la Pantalla
destWidth = picFondo(index).ScaleWidth
destHeight = picFondo(index).ScaleHeight
picFondo(index).PaintPicture picSource.Picture, 0, 0, destWidth, destHeight
End If
End Sub
Sub BuscarUbicacion(nAleatorio)
Dim u1, u2 As Integer
If Option1.Value Then
u1 = Round(Rnd(findex) * findex)
'MostrarImagen archivos(nAleatorio), facil(u1)
picFondo(facil(u1)).Tag = archivos(nAleatorio)
eliminardelista (u1)
u2 = Round(Rnd(findex) * findex)
'MostrarImagen archivos(nAleatorio), facil(u2)
picFondo(facil(u2)).Tag = archivos(nAleatorio)
eliminardelista (u2)
End If
If Option2.Value Then
u1 = Round(Rnd(mindex) * mindex)
'MostrarImagen archivos(nAleatorio), medio(u1)
picFondo(medio(u1)).Tag = archivos(nAleatorio)
eliminardelista (u1)
u2 = Round(Rnd(mindex) * mindex)
'MostrarImagen archivos(nAleatorio), medio(u2)
picFondo(medio(u2)).Tag = archivos(nAleatorio)
eliminardelista (u2)
End If
If Option3.Value Then
u1 = Round(Rnd(dindex) * dindex)
'MostrarImagen archivos(nAleatorio), dificil(u1)
picFondo(dificil(u1)).Tag = archivos(nAleatorio)
eliminardelista (u1)
u2 = Round(Rnd(dindex) * dindex)
'MostrarImagen archivos(nAleatorio), dificil(u2)
picFondo(dificil(u2)).Tag = archivos(nAleatorio)
eliminardelista (u2)
End If
End Sub
Sub eliminardelista(ByVal index)
If Option1.Value Then
facil(index) = facil(findex)
findex = findex - 1
End If
If Option2.Value Then
medio(index) = medio(mindex)
mindex = mindex - 1
End If
If Option3.Value Then
dificil(index) = dificil(dindex)
dindex = dindex - 1
End If
End Sub
Private Sub Form_Load()
Directorio_De_Imagenes = Trim(App.Path + "\IMAGENES\")
FilFondos = Trim(Directorio_De_Imagenes) + "OBJETOS\"
inicializar
Degradado Me
End Sub
Private Sub picFondo_Click(index As Integer)
If Destapadas(index) = 0 Then
If Carta1 <> -1 And Carta2 = -1 Then Carta2 = index
If Carta1 = -1 Then
Carta1 = index
Destapadas(Carta1) = 1
End If
If Carta1 <> -1 Then MostrarImagen picFondo(Carta1).Tag, Carta1
If Carta2 <> -1 Then
MostrarImagen picFondo(Carta2).Tag, Carta2
Timer1.Interval = 500
UltimaCarta = Carta2
End If
If Carta1 <> -1 And Carta2 <> -1 Then
If picFondo(Carta1).Tag = picFondo(Carta2).Tag Then
Destapadas(Carta1) = 1
Destapadas(Carta2) = 1
Pares = Pares + 1
If Option1.Value Then
If Pares = 2 Then findeljuego
End If
If Option2.Value Then
If Pares = 8 Then findeljuego
End If
If Option3.Value Then
If Pares = 12 Then findeljuego
End If
Else
TaparCarta (Carta1)
End If
Carta1 = -1
Carta2 = -1
End If
End If
End Sub
Sub TaparCarta(Carta1)
picFondo(Carta1).Cls
picFondo(Carta1).Picture = Picture2.Picture
Destapadas(Carta1) = 0
End Sub
Private Sub Timer1_Timer()
If Destapadas(UltimaCarta) = 0 Then TaparCarta (UltimaCarta)
Timer1.Interval = 0
End Sub
Sub findeljuego()
Dim juegos As Integer
If (MsgBox("Haz Terminado El Juego,Desea Jugar Otra Vez?", vbQuestion + vbYesNo) = vbYes) Then
Command4_Click
Else
inicializar
End If
End Sub
Private Sub Degradado(Formulario As Form)
Dim con As Integer
Dim Color_Rojo As Long
Dim Color_Verde As Long
Dim Color_Azul As Long
Formulario.AutoRedraw = True ' La propiedad AutoRedraw tiene que estar en True
If IsNull(Color_Rojo) Then Color_Rojo = 33
If IsNull(Color_Verde) Then Color_Verde = 96
Formulario.DrawStyle = vbInsideSolid
Formulario.DrawMode = vbCopyPen
Formulario.ScaleMode = vbPixels
Formulario.DrawWidth = 2
Formulario.ScaleHeight = 256
Color_Azul = 255
Color_Rojo = 0
For con = 0 To 255
Formulario.Line (0, con)-(Screen.Width, con - 1), RGB(Color_Rojo, Color_Verde, Color_Azul - con), B
Next con
End Sub
Option Explicit
Dim archivos(200) As String
Dim totalarchivos As Integer
Dim facil(3) As Integer
Dim medio(15) As Integer
Dim dificil(23) As Integer
Dim Destapadas(23) As Integer
Dim findex, mindex, dindex, aindex As Integer
Dim Carta1, Carta2, UltimaCarta As Integer
Dim arreglo(3, 5) As Integer
Dim Pares As Integer
Dim Tbusuario As ADODB.Recordset
Dim Directorio_De_Imagenes As String
Dim i As Integer
Dim j As Integer
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Command4_Click()
Dim Tamaño(2) As Integer
Dim nAleatorio As Integer
If Option1.Value Then
Tamaño(1) = 2
Tamaño(2) = 2
End If
If Option2.Value Then
Tamaño(1) = 4
Tamaño(2) = 4
End If
If Option3.Value Then
Tamaño(1) = 4
Tamaño(2) = 6
End If
inicializar
For i = 0 To ((Tamaño(1) * Tamaño(2))) - 1
If Option1.Value Then picFondo(facil(i)).Visible = True
If Option2.Value Then picFondo(medio(i)).Visible = True
If Option3.Value Then picFondo(dificil(i)).Visible = True
Next i
For i = 0 To ((Tamaño(1) * Tamaño(2)) / 2) - 1
nAleatorio = Round(Rnd(aindex) * aindex)
BuscarUbicacion nAleatorio
archivos(nAleatorio) = archivos(aindex)
aindex = aindex - 1
Next i
End Sub
Sub inicializar()
Dim n As Integer
Dim i As Integer
Dim j As Integer
findex = 3
mindex = 15
dindex = 23
Carta1 = -1
Carta2 = -1
Pares = 0
For i = 0 To FilFondos.ListCount - 1
FilFondos.Selected(i) = True
archivos(i) = FilFondos.FileName
Next
totalarchivos = i - 1
aindex = totalarchivos
n = 0
For i = 0 To 3
For j = 0 To 5
arreglo(i, j) = n
TaparCarta n
Destapadas(n) = 0
n = n + 1
Next j
Next i
n = 0
For i = 0 To 1
For j = 0 To 1
facil(n) = arreglo(i, j)
n = n + 1
Next j
Next i
n = 0
For i = 0 To 3
For j = 0 To 3
medio(n) = arreglo(i, j)
n = n + 1
Next j
Next i
n = 0
For i = 0 To 3
For j = 0 To 5
dificil(n) = arreglo(i, j)
picFondo(n).Visible = False
n = n + 1
Next j
Next i
End Sub
Sub MostrarImagen(File As String, index)
Dim destWidth As Single, destHeight As Single
Dim destX As Single, destY As Single
Dim stepX As Single, stepY As Single
If Dir(Trim(Directorio_De_Imagenes) + "OBJETOS\" + File) <> "" And Trim(Directorio_De_Imagenes) + "OBJETOS\" + File <> "" Then
picSource.Picture = LoadPicture(Trim(Directorio_De_Imagenes) + "OBJETOS\" + File)
picFondo(index).Cls
' Ajustar Tamaño Toda la Pantalla
destWidth = picFondo(index).ScaleWidth
destHeight = picFondo(index).ScaleHeight
picFondo(index).PaintPicture picSource.Picture, 0, 0, destWidth, destHeight
End If
End Sub
Sub BuscarUbicacion(nAleatorio)
Dim u1, u2 As Integer
If Option1.Value Then
u1 = Round(Rnd(findex) * findex)
'MostrarImagen archivos(nAleatorio), facil(u1)
picFondo(facil(u1)).Tag = archivos(nAleatorio)
eliminardelista (u1)
u2 = Round(Rnd(findex) * findex)
'MostrarImagen archivos(nAleatorio), facil(u2)
picFondo(facil(u2)).Tag = archivos(nAleatorio)
eliminardelista (u2)
End If
If Option2.Value Then
u1 = Round(Rnd(mindex) * mindex)
'MostrarImagen archivos(nAleatorio), medio(u1)
picFondo(medio(u1)).Tag = archivos(nAleatorio)
eliminardelista (u1)
u2 = Round(Rnd(mindex) * mindex)
'MostrarImagen archivos(nAleatorio), medio(u2)
picFondo(medio(u2)).Tag = archivos(nAleatorio)
eliminardelista (u2)
End If
If Option3.Value Then
u1 = Round(Rnd(dindex) * dindex)
'MostrarImagen archivos(nAleatorio), dificil(u1)
picFondo(dificil(u1)).Tag = archivos(nAleatorio)
eliminardelista (u1)
u2 = Round(Rnd(dindex) * dindex)
'MostrarImagen archivos(nAleatorio), dificil(u2)
picFondo(dificil(u2)).Tag = archivos(nAleatorio)
eliminardelista (u2)
End If
End Sub
Sub eliminardelista(ByVal index)
If Option1.Value Then
facil(index) = facil(findex)
findex = findex - 1
End If
If Option2.Value Then
medio(index) = medio(mindex)
mindex = mindex - 1
End If
If Option3.Value Then
dificil(index) = dificil(dindex)
dindex = dindex - 1
End If
End Sub
Private Sub Form_Load()
Directorio_De_Imagenes = Trim(App.Path + "\IMAGENES\")
FilFondos = Trim(Directorio_De_Imagenes) + "OBJETOS\"
inicializar
Degradado Me
End Sub
Private Sub picFondo_Click(index As Integer)
If Destapadas(index) = 0 Then
If Carta1 <> -1 And Carta2 = -1 Then Carta2 = index
If Carta1 = -1 Then
Carta1 = index
Destapadas(Carta1) = 1
End If
If Carta1 <> -1 Then MostrarImagen picFondo(Carta1).Tag, Carta1
If Carta2 <> -1 Then
MostrarImagen picFondo(Carta2).Tag, Carta2
Timer1.Interval = 500
UltimaCarta = Carta2
End If
If Carta1 <> -1 And Carta2 <> -1 Then
If picFondo(Carta1).Tag = picFondo(Carta2).Tag Then
Destapadas(Carta1) = 1
Destapadas(Carta2) = 1
Pares = Pares + 1
If Option1.Value Then
If Pares = 2 Then findeljuego
End If
If Option2.Value Then
If Pares = 8 Then findeljuego
End If
If Option3.Value Then
If Pares = 12 Then findeljuego
End If
Else
TaparCarta (Carta1)
End If
Carta1 = -1
Carta2 = -1
End If
End If
End Sub
Sub TaparCarta(Carta1)
picFondo(Carta1).Cls
picFondo(Carta1).Picture = Picture2.Picture
Destapadas(Carta1) = 0
End Sub
Private Sub Timer1_Timer()
If Destapadas(UltimaCarta) = 0 Then TaparCarta (UltimaCarta)
Timer1.Interval = 0
End Sub
Sub findeljuego()
Dim juegos As Integer
If (MsgBox("Haz Terminado El Juego,Desea Jugar Otra Vez?", vbQuestion + vbYesNo) = vbYes) Then
Command4_Click
Else
inicializar
End If
End Sub
Private Sub Degradado(Formulario As Form)
Dim con As Integer
Dim Color_Rojo As Long
Dim Color_Verde As Long
Dim Color_Azul As Long
Formulario.AutoRedraw = True ' La propiedad AutoRedraw tiene que estar en True
If IsNull(Color_Rojo) Then Color_Rojo = 33
If IsNull(Color_Verde) Then Color_Verde = 96
Formulario.DrawStyle = vbInsideSolid
Formulario.DrawMode = vbCopyPen
Formulario.ScaleMode = vbPixels
Formulario.DrawWidth = 2
Formulario.ScaleHeight = 256
Color_Azul = 255
Color_Rojo = 0
For con = 0 To 255
Formulario.Line (0, con)-(Screen.Width, con - 1), RGB(Color_Rojo, Color_Verde, Color_Azul - con), B
Next con
End Sub
Valora esta pregunta


0