modMemorama1 - 1
Public intNumero(499) As Integer
Public intChecar, intImagen1, intImagen2, intParNon As Integer
Sub
'
'
'
Generar_Numeros(intCantidad As Integer)
Con este sub se genera una lista de numeros aleatoria y sin repetir
en al array intNumero pasando la cantidad de numeros que se quieren
generar como argumento
Dim bTerminado, bRegreso As Boolean
Dim intNum, intX
Randomize
intNumero(0) = Int(Rnd() * intCantidad)
bTerminado = False
intNum = 1
Do While Not bTerminado
intNumero(intNum) = Int(Rnd() * intCantidad)
bRegreso = False
For intX = intNum - 1 To 0 Step -1
If intNumero(intNum) = intNumero(intX) Then
bRegreso = True
End If
Next intX
If bRegreso = False Then
intNum = intNum + 1
End If
If intNum = intCantidad Then
bTerminado = True
End If
Loop
End Sub
Sub Desacomodar_Todo()
' En este sub acomodo las imagenes y lea etiquetas
Dim intX As Integer
' Genero 30 numeros de 0 a 29 y se ponen en el array intNumero
Generar_Numeros (30)
' Con este for acomodo las imagenes y las etiquetas
' de forma aleatoria en el frmMemo
For intX = 0 To 29
' Con este select se acomoda la propiedad Top
' de las imagenes y etiquetas
Select Case intNumero(intX)
Case 0, 1, 2, 3, 4
frmMemo.imgImagen(intX).Top = 200
frmMemo.lblboton(intX).Top = 200
Case 5, 6, 7, 8, 9
frmMemo.imgImagen(intX).Top = 1532
frmMemo.lblboton(intX).Top = 1532
Case 10, 11, 12, 13, 14
frmMemo.imgImagen(intX).Top = 2865
frmMemo.lblboton(intX).Top = 2865
Case 15, 16, 17, 18, 19
frmMemo.imgImagen(intX).Top = 4197
frmMemo.lblboton(intX).Top = 4197
Case 20, 21, 22, 23, 24
frmMemo.imgImagen(intX).Top = 5530
frmMemo.lblboton(intX).Top = 5530
Case 25, 26, 27, 28, 29
frmMemo.imgImagen(intX).Top = 6862
frmMemo.lblboton(intX).Top = 6862
End Select
' Aqui acomodo las propiedaes Left
Select Case intNumero(intX)
Case 0, 5, 10, 15, 20, 25
frmMemo.imgImagen(intX).Left = 200
frmMemo.lblboton(intX).Left = 200
Case 1, 6, 11, 16, 21, 26
frmMemo.imgImagen(intX).Left = 2360
frmMemo.lblboton(intX).Left = 2360
Case 2, 7, 12, 17, 22, 27
frmMemo.imgImagen(intX).Left = 4520
frmMemo.lblboton(intX).Left = 4520
Case 3, 8, 13, 18, 23, 28
modMemorama1 - 2
frmMemo.imgImagen(intX).Left = 6680
frmMemo.lblboton(intX).Left = 6680
Case 4, 9, 14, 19, 24, 29
frmMemo.imgImagen(intX).Left = 8840
frmMemo.lblboton(intX).Left = 8840
End Select
Next intX
End Sub
Sub Acomodar_Todo()
' Este sub acomoda todas las imagenes en su lugar inicial
Dim intX As Integer
For intX = 0 To 29
Select Case intX
Case 0, 1, 2, 3, 4
frmMemo.imgImagen(intX).Top = 200
frmMemo.lblboton(intX).Top = 200
Case 5, 6, 7, 8, 9
frmMemo.imgImagen(intX).Top = 1532
frmMemo.lblboton(intX).Top = 1532
Case 10, 11, 12, 13, 14
frmMemo.imgImagen(intX).Top = 2865
frmMemo.lblboton(intX).Top = 2865
Case 15, 16, 17, 18, 19
frmMemo.imgImagen(intX).Top = 4197
frmMemo.lblboton(intX).Top = 4197
Case 20, 21, 22, 23, 24
frmMemo.imgImagen(intX).Top = 5530
frmMemo.lblboton(intX).Top = 5530
Case 25, 26, 27, 28, 29
frmMemo.imgImagen(intX).Top = 6862
frmMemo.lblboton(intX).Top = 6862
End Select
Select Case intX
Case 0, 5, 10, 15, 20, 25
frmMemo.imgImagen(intX).Left = 200
frmMemo.lblboton(intX).Left = 200
Case 1, 6, 11, 16, 21, 26
frmMemo.imgImagen(intX).Left = 2360
frmMemo.lblboton(intX).Left = 2360
Case 2, 7, 12, 17, 22, 27
frmMemo.imgImagen(intX).Left = 4520
frmMemo.lblboton(intX).Left = 4520
Case 3, 8, 13, 18, 23, 28
frmMemo.imgImagen(intX).Left = 6680
frmMemo.lblboton(intX).Left = 6680
Case 4, 9, 14, 19, 24, 29
frmMemo.imgImagen(intX).Left = 8840
frmMemo.lblboton(intX).Left = 8840
End Select
Next intX
End Sub
Sub Cargar_Imagenes()
' En este sub cargo las imagenes en las imgImagen
Dim intX, intContador As Integer
Generar_Numeros (112)
intContador = 0
For intX = 0 To 28 Step 2
frmMemo.imgImagen(intX).Picture = LoadPicture(App.Path + _
"\imagenes\" + Trim(Str(intNumero(intContador))) + ".jpg")
frmMemo.imgImagen(intX + 1).Picture = LoadPicture(App.Path + _
"\imagenes\" + Trim(Str(intNumero(intContador))) + ".jpg")
intContador = intContador + 1
Next intX
End Sub
Sub Ocultar_Imagenes()
' Con este sub aculto las imagenes y muestro las etiquetas
Dim intX As Integer
For intX = 0 To 29
frmMemo.imgImagen(intX).Visible = False
frmMemo.lblboton(intX).Visible = True
Next intX
modMemorama1 - 3
End Sub
Sub Mostrar_Imagenes()
' Este sub muestra las imagenes y oculta las etiquetas
Dim intX As Integer
For intX = 0 To 29
frmMemo.imgImagen(intX).Visible = True
frmMemo.lblboton(intX).Visible = False
Next intX
End Sub
Sub Cargar_Etiquetas()
' Este sub pone la imagen de atras de las etiquetas (cartas)
Dim intX As Integer
For intX = 0 To 29
frmMemo.lblboton(intX).Picture = LoadPicture(App.Path + "\imagenes\etiqueta.jpg")
Next intX
End Sub
Sub Checar_Final()
' Este sub checa si estan todas las imagenes destapadas
Dim bRegreso, bTerminado As Boolean
Dim intContador, intFin As Integer
bRegreso = False
bTerminado = False
intContador = 0
Do While (Not bRegreso) Or (bTerminado)
If frmMemo.imgImagen(intContador).Visible = False Then
bRegreso = True
End If
If intContador = 29 Then
bTerminado = True
Exit Do
End If
intContador = intContador + 1
Loop
If bTerminado Then
intFin = MsgBox("Quieres Jugar Otro", vbYesNo, "Felicidades")
Select Case intFin
Case 6 ' Si
Cargar_Imagenes
Mostrar_Imagenes
Acomodar_Todo
frmMemo.cmdEmpezar.Enabled = True
frmMemo.cmdOtras.Enabled = True
Case 7 ' No
MsgBox "GRACIAS POR JUGAR", vbInformation
End
End Select
End If
End Sub
Sub Main()
If App.PrevInstance = False Then
frmMemo.Show
Else
MsgBox "El Memorama ya esta en ejecucin.", vbInformation
End If
End Sub
