El código es el siguiente:

Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)

'Source.Move X, Y

Source.Move (X - Source.Width / 2), (Y - Source.Height / 2)

End Sub

El ejercicio puede bajarse de Aquí.

Esta es una version de las maquinitas tragamonedas. Arrastramos una moneda de 1$ sobre el Botón Apostar y se habilita el Botón Jugar, cuando nos pàrece hacemos Click en el Botón Detener, y si las tres imagenes son iguales: ganamos sino perdimos, y volvemos a intentarlo. En tiempo de ejecución se ve parecido a la imagen:

El código es el siguiente:

Usamos la API de Windows sndPlaySound para activar el sonido. Pueden copiarla de aquí textualmente o convocarla desde el Visor de las API de Visual Basic.

Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Const SND_ASYNC = &H1 ' reproducción asíncrona

Option Explicit

Dim snd As Integer

Dim a As Integer

Dim n1 As Integer

Dim n2 As Integer

Dim n3 As Integer

Private Sub Command1_DragOver(Source As Control, X As Single, Y As Single, State As Integer)

'Dragea la moneda sobre el botón Apostar

Source.Visible = False

Command2.Enabled = True 'habilita el Botón Jugar

End Sub

Private Sub Command2_Click() 'Botón Jugar

'Aquí usamos la API de windows para ejecutar el sonido

snd = sndPlaySound(App.Path & "\1toons1.wav", SND_ASYNC)

'Habilita el timer de la animación del tragamonedas

Timer1.Enabled = True

Command4.Enabled = True

End Sub

Private Sub Command3_Click()

'Salida del programa

Unload Me

End Sub

Private Sub Command4_Click()

'Detiene la animación. Inhabilita el botón Jugar y llama al procedimiento 'que elige al azar los números

Timer1.Enabled = False

Command2.Enabled = False

Call azar 'llama al procedimiento Azar que eleige tres números

Command4.Enabled = False

End Sub

Private Sub Form_Load()

Randomize

End Sub

Private Sub Timer1_Timer()

'Animación pasando las imagenes de la tragamoneda

a = a + 1 If a = 1 Then

Image1.Picture = Picture1(0).Picture

Image2.Picture = Picture1(1).Picture

Image3.Picture = Picture1(2).Picture

End If

If a = 2 Then

Image1.Picture = Picture1(1).Picture

Image2.Picture = Picture1(2).Picture

Image3.Picture = Picture1(0).Picture

End If

If a = 3 Then

Image1.Picture = Picture1(2).Picture

Image2.Picture = Picture1(0).Picture

Image3.Picture = Picture1(1).Picture

a = 0

End If

End Sub

Private Sub azar()

'Procedimiento que elige tres números al azar correspondientes a cada 'imagen

n1 = Int(Rnd * 3) + 1

n2 = Int(Rnd * 3) + 1

n3 = Int(Rnd * 3) + 1

Timer1.Enabled = False

Select Case n1

Case 1

Image1.Picture = Picture1(0).Picture

Case 2

Image1.Picture = Picture1(1).Picture

Case 3

Image1.Picture = Picture1(2).Picture

End Select

n1 = n1

Select Case n2

Case 1

Image2.Picture = Picture1(0).Picture

Case 2

Image2.Picture = Picture1(1).Picture

Case 3

Image2.Picture = Picture1(2).Picture

End Select

n2 = n2

Select Case n3

Case 1

Image3.Picture = Picture1(0).Picture

Case 2

Image3.Picture = Picture1(1).Picture

Case 3

Image3.Picture = Picture1(2).Picture

End Select

n3 = n3

'Llama al procedimiento que controla si los tres numeros elegidos al azar son iguales.

Call ganar

End Sub

Private Sub ganar()

'Procedimiento que controla si los tres números al azar son iguales ganó, sino perdió

Dim m As Integer

If n1 = n2 And n2 = n3 Then Label1.Caption = "¡¡Ganaste!!"

snd = sndPlaySound(App.Path & "\Cash2.wav", SND_ASYNC)

For m = 0 To 6

Image4(m).Visible = True

Next m

Else

Label1.Caption = "¡¡Perdiste!!"

snd = sndPlaySound(App.Path & "\NoTiempo.wav", SND_ASYNC)

End If

'llama al procedimiento que controla si se terminó el dinero.

Call dinero

End Sub

Private Sub dinero()

' Procedimiento que Controla si se acabó el dinero

If Image4(0).Visible = False And Image4(1).Visible = False And_ Image4(2).Visible = False And Image4(3).Visible = False And_ Image4(4).Visible = False And Image4(5).Visible = False And_ Image4(5).Visible = False Then

Label1.Caption = "¡¡Sin Dinero!!"

End If

End Sub

Como vemos en esta aplicación tenemos varios procedimientos creados : Azar, ganar y dinero que eligen los tres numeros al azar que cargan las imágenes, ganar que controla si las tres imagenes son iguales y dinero que controla que las monedas de 1$ se agotaron. Y un Select Case que elige que imagen corresponde a cada numero.

El código completo puede bajarse de Aquí.

En el forrmulario insertamos un control PictureBox donde cargamos el corazón y un control Timer que controla la animación del corazón en la pantalla. El código es:

Option Explicit

Dim movimiento As Integer

Dim puntero As Integer

Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long

Private Sub Form_Click()

puntero = ShowCursor(-1)

End

End Sub

Private Sub Form_DblClick()

puntero = ShowCursor(-1)

End

End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)

puntero = ShowCursor(-1)

End

End Sub

Private Sub Form_Load()

If App.PrevInstance Then

End

puntero = ShowCursor(0)

movimiento = 3

End Sub

Private Sub

Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

Static X1 As Integer, Y1 As Integer

If X1 = 0 And Y1 = 0 Then

X1 = x

Y1 = y

Exit Sub

End If

If Abs(X1 - x) < 5 And Abs(Y1 - y) < 5 Then

X1 = x Y1 = y

Exit Sub

End If

puntero = ShowCursor(-1)

End

End Sub

Private Sub Timer1_Timer()

'1 hacia arriba y hacia la izquierda

'2 hacia arriba y a la derecha

'3 hacia abajo y a la derecha

'4 hacia abajo y a la izquierda

Select Case movimiento

Case 1

Picture1.Move Picture1.Left - 20, Picture1.Top - 20

If Picture1.Left <= 0 Then

movimiento = 2

ElseIf Picture1.Top <= 0 Then

movimiento = 4

End If

Case 2

Picture1.Move Picture1.Left + 20, Picture1.Top - 20

If Picture1.Left >= (Form1.Width - Picture1.Width) Then

movimiento = 1

ElseIf Picture1.Top <= 0 Then

movimiento = 3

End If

Case 3

Picture1.Move Picture1.Left + 20, Picture1.Top + 20

If Picture1.Left >= (Form1.Width - Picture1.Width) Then

movimiento = 4

ElseIf Picture1.Top >= (Form1.Height - Picture1.Height) Then

movimiento = 2

End If

Case 4

Picture1.Move Picture1.Left - 20, Picture1.Top + 20

If Picture1.Left <= 0 Then

movimiento = 3

ElseIf Picture1.Top >= (Form1.Height - Picture1.Height) Then

movimiento = 1

End If

End Select

End Sub

Para esta aplicación vamos a usar una API de window para mostrar y ocultar el puntero del mouse, SHOWCURSOR, y tambien vamos a registrar un pequeño movimiento del mouse para que se cierre el programa, asi como tocar una tecla. La animacion controla en cuatro movimientos el desplazamiento del corazón en diagonal hasta llegar al borde, y allí cambia la dirrección.

El archivo completo puede bajarse de Aquí.

Tenemos una Label y tres Pictures, la 2 es la goma, la 3 el marcador (en el medio) y la 1 el lápiz. La idea es que al hacer click en el lápiz quede en el puntero del mouse y así luego hacemos click en la label y aparece la palabra Tarea, como si la hubiésemos escrito, luego dejamos el lápiz haciendo Click en el Formulario. Hacemos Click en la goma y luego en la label y se borra la palabra Tarea. Hacemos Click en el formulario y dejamos la goma. Y al hacer click en el marcador y tenerlo en el puntero del mouse hacemos Click en la Label y esta se vuelve roja, antes era color amarillo. El código es:

Option Explicit

Private Sub Form_Click()

If MouseIcon = Picture1.Picture Then ' aqui volvemos al puntero estándar

MousePointer = 0

Picture1.Visible = True

End If

If MouseIcon = Picture2.Picture Then

MousePointer = 0

Picture2.Visible = True

End If

If MouseIcon = Picture3.Picture Then

MousePointer = 0

Picture3.Visible = True

End If

End Sub

Private Sub

Label1_Click()

If MouseIcon = Picture1.Picture Then ' si el puntero es el lápiz la label 'muestra la palabra Tarea en su caption.

Label1.Caption = "Tarea"

End If

If MouseIcon = Picture2.Picture Then ' si el puntero es la goma borra Tarea.

Label1.Caption = ""

Label1.BackColor = vbYellow ' fondo de la label amarillo

End If

If MouseIcon = Picture3.Picture Then ' si el puntero es el marcador el fondo se vuelve 'rojo

Label1.Caption = ""

Label1.BackColor = VBred

End If

End Sub

Private Sub Picture1_Click()'carga el icono del lápiz

MouseIcon = Picture1.Picture

MousePointer = 99

Picture1.Visible = False

End Sub

Private Sub Picture2_Click()'carga el icono en el puntero de la goma MouseIcon = Picture2.Picture

MousePointer = 99

Picture2.Visible = False

End Sub

Private Sub Picture3_Click()'carga el icono en el puntero del marcador MouseIcon = Picture3.Picture

MousePointer = 99

Picture3.Visible = False

End Sub

El código del ejercicio lo podes bajar de Aquí.

Option Explicit

Dim paso As Integer

Dim i As Integer

Dim tramo1 As String

Dim tramo2 As String

Dim tramo3 As String

Dim tramo4 As String

Private Sub Label1_Click()

Label1.Tag = "si"

Label2.Tag = "no"

Label3.Tag = "no"

Label6.Caption = "A: 500 mts."

Label7.Caption = "B: 500 mts. al Oeste"

Label8.Caption = "C: 4000 mts."

Label9.Caption = "D: 1000 mts."

Timer1.Enabled = True

End Sub

Private Sub Label6_Click()

If Label1.Tag = "si" Then

Label5.Caption = "La respuesta Correcta es la C, porque la distancia total recorrida es de 4000 mts."

Label5.Visible = True

End If

End Sub

Private Sub

Label7_Click()

If Label1.Tag = "si" Then

Label5.Caption = "La respuesta Correcta es la C, porque la distancia total recorrida es de 4000 mts."

Label5.Visible = True

End If

End Sub

Private Sub Label8_Click()

If Label1.Tag = "si" Then

Label5.Caption = "La respuesta Correcta es la C, porque la distancia total recorrida es de 4000 mts."

Label5.Visible = True

End If

End Sub

Private Sub Label9_Click()

If Label1.Tag = "si" Then

Label5.Caption = "La respuesta Correcta es la C, porque la distancia total recorrida es de 4000 mts."

Label5.Visible = True

End If

End Sub

Private Sub Timer1_Timer()

If paso = 1 Then

Picture2.Move Picture2.Left - 100, Picture2.Top ElseIf paso = 2 Then Picture2.Move Picture2.Left - 100, Picture2.Top ElseIf paso = 3 Then Picture2.Move Picture2.Left - 150, Picture2.Top ElseIf paso = 4 Then Picture2.Move Picture2.Left - 150, Picture2.Top ElseIf paso = 5 Then Picture2.Move Picture2.Left - 150, Picture2.Top ElseIf paso = 6 Then Picture2.Move Picture2.Left - 150, Picture2.Top ElseIf paso = 7 Then Picture2.Move Picture2.Left - 150, Picture2.Top ElseIf paso = 8 Then Picture2.Move Picture2.Left - 150, Picture2.Top ElseIf paso = 9 Then Picture2.Move Picture2.Left - 150, Picture2.Top ElseIf paso = 10 Then Picture2.Move Picture2.Left - 150, Picture2.Top ElseIf paso = 11 Then Picture2.Move Picture2.Left - 150, Picture2.Top ElseIf paso = 12 Then Picture2.Move Picture2.Left - 150, Picture2.Top ElseIf paso = 13 Then Picture2.Move Picture2.Left - 150, Picture2.Top ElseIf paso = 14 Then Picture2.Move Picture2.Left - 150, Picture2.Top ElseIf paso = 15 Then Picture2.Move Picture2.Left - 150, Picture2.Top ElseIf paso = 16 Then Picture2.Move Picture2.Left - 150, Picture2.Top ElseIf paso = 17 Then Picture2.Move Picture2.Left - 58, Picture2.Top

tramo1 = " El tren se desplaza 1000 mts. al Oeste, "

Label4.Caption = tramo1

ElseIf paso = 18 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 19 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 20 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 21 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 22 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 23 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 24 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 25 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 26 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 28 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 29 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 30 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 31 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 32 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 33 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 34 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 35 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 36 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 37 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 38 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 39 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 40 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 41 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 42 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 43 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 44 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 45 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 46 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 47 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 48 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 49 Then Picture2.Move Picture2.Left + 150, Picture2.Top ElseIf paso = 50 Then Picture2.Move Picture2.Left + 126, Picture2.Top tramo2 = " 2000 mts al Este,"

Label4.Caption = Label4.Caption & tramo2

ElseIf paso = 51 Then Picture2.Move Picture2.Left - 150, Picture2.Top ElseIf paso = 52 Then Picture2.Move Picture2.Left - 150, Picture2.Top ElseIf paso = 53 Then Picture2.Move Picture2.Left - 150, Picture2.Top ElseIf paso = 54 Then Picture2.Move Picture2.Left - 150, Picture2.Top ElseIf paso = 55 Then Picture2.Move Picture2.Left - 150, Picture2.Top ElseIf paso = 56 Then Picture2.Move Picture2.Left - 150, Picture2.Top ElseIf paso = 57 Then Picture2.Move Picture2.Left - 150, Picture2.Top ElseIf paso = 58 Then Picture2.Move Picture2.Left - 100, Picture2.Top ElseIf paso = 59 Then Picture2.Move Picture2.Left - 60, Picture2.Top tramo3 = " 500 mts. al Oeste, "

Label4.Caption = Label4.Caption & tramo3

ElseIf paso = 60 Then Picture2.Move Picture2.Left + 250, Picture2.Top ElseIf paso = 61 Then Picture2.Move Picture2.Left + 250, Picture2.Top ElseIf paso = 62 Then Picture2.Move Picture2.Left + 250, Picture2.Top ElseIf paso = 63 Then Picture2.Move Picture2.Left + 250, Picture2.Top ElseIf paso = 64 Then Picture2.Move Picture2.Left + 210, Picture2.Top tramo4 = " y 500 mts al Este. ¿Que distancia Recorrió?"

Label4.Caption = Label4.Caption & tramo4 End If paso = paso + 1

End Sub

Pongo los condicionales en un solo renglon para ahorrar espacio, ustedes corrigan la sintaxis y tambien pueden abreviar codigo creando procedimientos que se repiten.

El código pueden bajarlo de AQUÍ.

Option Explicit

Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Const SND_ASYNC = &H1 ' play asynchronously

Dim sonido As Integer

Dim a As Integer

Dim b As Integer

Dim c As Integer

Dim d As Integer

Dim e As Integer

Dim f As Integer

Dim g As Integer

Dim h As Integer

Dim i As Integer

Dim j As Integer

Dim patos As Integer

Dim patosin As Integer

Dim patosout As Integer

Private Sub Form_Load()

Randomize

End Sub

Private Sub mniDía_Click()

mniDía.Checked = True

mnuNoche.Checked = False

Form1.Picture = Image1.Picture

Timer1.Enabled = True

Timer3.Enabled = True

Timer5.Enabled = True

Timer7.Enabled = True

Timer9.Enabled = True

Timer4.Enabled = False

Timer2.Enabled = False

Timer6.Enabled = False

Timer8.Enabled = False

Timer10.Enabled = False

Picture6.Visible = False

Picture7.Visible = False

Picture1.Visible = False

Picture8.Visible = False

Picture9.Visible = False

End Sub Private Sub mnuNoche_Click()

mniDía.Checked = False

mnuNoche.Checked = True

Form1.Picture = Image2.Picture

Timer2.Enabled = True

Timer4.Enabled = True

Timer6.Enabled = True

Timer8.Enabled = True

Timer10.Enabled = True

Timer1.Enabled = False

Timer3.Enabled = False

Timer5.Enabled = False

Timer7.Enabled = False

Timer9.Enabled = False

Picture6.Visible = False

Picture7.Visible = False

Picture1.Visible = False

Picture8.Visible = False

Picture9.Visible = False

End Sub

Private Sub mnuNuevo_Click()

Picture1.Left = 0

Picture1.Top = 480

Picture6.Left = 1560

Picture6.Top = 1440

Picture7.Left = 480

Picture7.Top = 2760

Picture8.Left = 2400

Picture8.Top = 240

Picture9.Left = 2880

Picture9.Top = 2160

Picture1.Visible = True

Picture8.Visible = True

Picture6.Visible = True

If mniDía.Checked = True Then

Timer1.Enabled = True

Timer3.Enabled = True

Timer5.Enabled = True

Timer7.Enabled = True

Timer9.Enabled = True

ElseIf mnuNoche.Checked = True Then

Timer2.Enabled = True

Timer4.Enabled = True

Timer6.Enabled = True

Timer8.Enabled = True

Timer10.Enabled = True

End If

End Sub

Private Sub mnuSalir_Click()

End

End Sub

Private Sub Picture1_Click()

sonido = sndPlaySound(App.Path & "\shoot.wav", SND_ASYNC)

If Timer1.Enabled = True Then

Timer1.Enabled = False

Picture1.Picture = Picture3.Picture

Call pausa

Picture1.Visible = False

patosin = patosin + 1

Call final

Picture1.Picture = Picture2(0).Picture

ElseIf Timer2.Enabled = True Then

Timer2.Enabled = False

Picture1.Picture = Picture5.Picture

Call pausa

Picture1.Visible = False

patosin = patosin + 1

Call final

Picture1.Picture = Picture4(0).Picture

End If

End Sub

Private Sub Picture6_Click()

sonido = sndPlaySound(App.Path & "\shoot.wav", SND_ASYNC)

If Timer5.Enabled = True Then

Timer5.Enabled = False

Picture6.Picture = Picture3.Picture

Call pausa

Picture6.Visible = False

patosin = patosin + 1

Call final

Picture6.Picture = Picture2(0).Picture

ElseIf Timer6.Enabled = True Then

Timer6.Enabled = False

Picture6.Picture = Picture5.Picture

Call pausa

Picture6.Visible = False

patosin = patosin + 1

Call final

Picture6.Picture = Picture4(0).Picture

End If

End Sub

Private Sub Picture7_Click()

sonido = sndPlaySound(App.Path & "\shoot.wav", SND_ASYNC)

If Timer9.Enabled = True Then

Timer9.Enabled = False

Picture7.Picture = Picture3.Picture

Call pausa

Picture7.Visible = False

patosin = patosin + 1

Call final

Picture7.Picture = Picture2(0).Picture

ElseIf Timer10.Enabled = True Then

Timer10.Enabled = False

Picture7.Picture = Picture5.Picture

Call pausa

Picture7.Visible = False

patosin = patosin + 1

Call final

Picture7.Picture = Picture4(0).Picture

End If

End Sub

Private Sub Picture8_Click()

sonido = sndPlaySound(App.Path & "\shoot.wav", SND_ASYNC)

If Timer3.Enabled = True Then

Timer3.Enabled = False

Picture8.Picture = Picture3.Picture

Call pausa

Picture8.Visible = False

patosin = patosin + 1

Call final

Picture8.Picture = Picture2(0).Picture

ElseIf Timer4.Enabled = True Then

Timer4.Enabled = False

Picture8.Picture = Picture5.Picture

Call pausa

Picture8.Visible = False

patosin = patosin + 1

Call final

Picture8.Picture = Picture4(0).Picture

End If

End Sub

Private Sub Picture9_Click()

sonido = sndPlaySound(App.Path & "\shoot.wav", SND_ASYNC)

If Timer7.Enabled = True Then

Timer7.Enabled = False

Picture9.Picture = Picture3.Picture

Call pausa

Picture9.Visible = False

patosin = patosin + 1

Call final

Picture9.Picture = Picture2(0).Picture

ElseIf Timer8.Enabled = True Then

Timer8.Enabled = False

Picture9.Picture = Picture5.Picture

Call pausa

Picture9.Visible = False patosin = patosin + 1

Call final

Picture9.Picture = Picture4(0).Picture

End If

End Sub

Private Sub Timer1_Timer()

a = a + 1

If a = 3 Then

a = 0

Picture1.Picture = Picture2(a).Picture

Picture1.Visible = True

Dim r As Integer

r = Int(Rnd * 20)

Picture1.Move Picture1.Left + 200, Picture1.Top + r

End Sub

Private SubTimer10_Timer()

j = j + 1 If j = 3 Then

j = 0

Picture7.Picture = Picture4(c).Picture

Picture7.Visible = True

Dim r As Integer

r = Int(Rnd * 30)

Picture7.Move Picture7.Left + 200, Picture7.Top - r

End Sub

Private Sub Timer2_Timer()

b = b + 1 If b = 3 Then b = 0

Picture1.Picture = Picture4(b).Picture

Picture1.Visible = True

Dim r As Integer

r = Int(Rnd * 20)

Picture1.Move Picture1.Left + 200, Picture1.Top + r

End Sub

Private Sub pausa()

Dim comenzar

Dim controlar

comenzar = Timer

Do Until controlar >= comenzar + 0.3

controlar = Timer

DoEvents

Loop

End Sub

Private Sub Timer3_Timer()

c = c + 1

If c = 3 Then

c = 0

Picture8.Picture = Picture2(c).Picture

Picture8.Visible = True

Picture8.Move Picture8.Left + 200, Picture8.Top

End Sub

Private Sub Timer4_Timer()

d = d + 1 If d = 3 Then

d = 0

Picture8.Picture = Picture4(d).Picture

Picture8.Visible = True

Picture8.Move Picture8.Left + 200, Picture8.Top

End Sub

Private Sub Timer5_Timer()

e = e + 1

If e = 3 Then

e = 0

Picture6.Picture = Picture2(c).Picture

Picture6.Visible = True

Picture6.Move Picture6.Left + 200, Picture6.Top

End Sub

Private Sub Timer6_Timer()

f = f + 1

If f = 3 Then

f = 0

Picture6.Picture = Picture4(c).Picture

Picture6.Visible = True

Picture6.Move Picture6.Left + 200, Picture6.Top

End Sub

Private Sub Timer7_Timer()

g = g + 1

If g = 3 Then

g = 0

Picture9.Picture = Picture2(c).Picture

Picture9.Visible = True

Dim r As Integer

r = Int(Rnd * 30)

Picture9.Move Picture9.Left + 200, Picture9.Top - r

End Sub

Private Sub Timer8_Timer()

h = h + 1

If h = 3 Then

h = 0

Picture9.Picture = Picture4(c).Picture

Picture9.Visible = True

Dim r As Integer

r = Int(Rnd * 30)

Picture9.Move Picture9.Left + 200, Picture9.Top - r

End Sub

Private Sub Timer9_Timer()

i = i + 1

If i = 3 Then

i = 0

Picture7.Picture = Picture2(c).Picture

Picture7.Visible = True

Dim r As Integer

r = Int(Rnd * 30)

Picture7.Move Picture7.Left + 200, Picture7.Top - r

End Sub

Private Sub final()

Label1.Caption = " Cazaste: " & patosin

If patosin = 10 Then

Form2.Label1.Caption = "¡¡¡ Felicitaciones !!! Eres un Buen Cazador."

sonido = sndPlaySound(App.Path & "\clarin.wav", SND_ASYNC)

Form2.Show 1

ElseIf patosin = 20 Then

Form2.Label1.Caption = "¡¡¡ Felicitaciones !!! Eres un Muy Buen Cazador."

sonido = sndPlaySound(App.Path & "\clarin.wav", SND_ASYNC)

Form2.Show 1

ElseIf patosin = 50 Then

Form2.Label1.Caption = "¡¡¡ Felicitaciones !!! Eres un Excelente Cazador."

sonido = sndPlaySound(App.Path & "\clarin.wav", SND_ASYNC)

Form2.Show 1

ElseIf patosin = 100 Then

Form2.Label1.Caption = "¡¡¡ Felicitaciones !!! Eres el Mejor Cazador."

sonido = sndPlaySound(App.Path & "\clarin.wav", SND_ASYNC)

Form2.Show 1

End If

End Sub

El código puede bajarse de Aquí sin los archivos de sonido.

Option Explicit

Private Sub pausa()

Dim comenzar

Dim controlar

comenzar = Timer

Do Until controlar >= comenzar + 2

controlar = Timer

DoEvents

Loop

End Sub

Private Sub Command1_Click()

End

End Sub

Private Sub Timer1_Timer()

Picture1.Move Picture1.Left, Picture1.Top + 150

'con el condicional controla el reposicionarse.

If Picture1.Top > 7000 Then

Picture1.Top = -300

Picture2.Move Picture2.Left, Picture2.Top + 150

If Picture2.Top > 6500 Then

Picture2.Top = -200 Picture4.Move

Picture4.Left, Picture4.Top + 150

If Picture4.Top > 6500 Then

Picture4.Top = -100 Picture5.Move

Picture5.Left, Picture5.Top + 150

If Picture5.Top > 6500 Then

Picture5.Top = -100

Picture9.Move Picture9.Left, Picture9.Top + 150

If Picture9.Top > 6500 Then

Picture9.Top = -100

Picture10.Move Picture10.Left, Picture10.Top + 150

If Picture10.Top > 6500 Then

Picture10.Top = -200

Picture11.Move Picture11.Left, Picture11.Top + 150

If Picture11.Top > 6500 Then

Picture11.Top = -300

Picture12.Move Picture12.Left, Picture12.Top + 150

If Picture12.Top > 6500 Then

Picture12.Top = -100

End Sub

Private Sub Timer2_Timer()

Picture3.Picture = Picture7.Picture

Timer1.Interval = 600

Call pausa

Picture3.Picture = Picture6.Picture

Timer1.Interval = 0

If Picture2.Top >= 4600 Then

Picture2.Visible = False

If Picture4.Top >= 4600 Then

Picture4.Visible = False

If Picture5.Top >= 4600 Then

Picture5.Visible = False

If Picture9.Top >= 4600 Then

Picture9.Visible = False

If Picture10.Top >= 4600 Then

Picture10.Visible = False

If Picture11.Top >= 4600 Then

Picture11.Visible = False

If Picture12.Top >= 4600 Then

Picture12.Visible = False

If Picture1.Top >= 4600 Then

Picture1.Visible = False Timer3.Enabled = True

Call pausa

Call pausa

Call pausa

Picture3.Picture = Picture7.Picture

Timer3.Enabled = False

Image1.Left = 1200

Timer1.Enabled = True

Timer1.Interval = 400

Picture1.Top = 1200

Picture1.Visible = True

Picture2.Top = 2880

Picture2.Visible = True

Picture4.Top = 2760

Picture4.Visible = True

Picture5.Top = 1680

Picture5.Visible = True

Picture9.Top = 120

Picture9.Visible = True

Picture10.Top = 0

Picture10.Visible = True

Picture11.Top = 4200

Picture11.Visible = True

Picture12.Top = 4440

Picture12.Visible = True

Call pausa

Picture3.Picture = Picture8.Picture

Timer1.Interval = 150

Call pausa

End Sub

Private Sub Timer3_Timer()

Image1.Move Image1.Left + 100

End Sub

El código completo puede bajarse de Aquí.

Private Sub Command1_Click()

Dim alto As Long

Dim ancho As Long

With Printer

.ScaleMode = vbTwips

alto = .ScaleHeight

ancho = .ScaleWidth

End With

alto = alto \ 2 - Picture1.ScaleHeight \ 2

ancho = ancho \ 2 - Picture1.ScaleWidth \ 2

Printer.PaintPicture Picture1.Picture, ancho, alto, Picture1.ScaleWidth, Picture1.ScaleHeight

Printer.EndDoc

End Sub

El archivo completo puede bajarse de Aquí.

Private Sub pausa()

Dim comenzar

Dim chequeo

comenzar = Timer

Do Until chequeo >= comenzar + 1

chequeo = Timer

DoEvents 'esto hace que windows escuche otras acciones

Loop

End Sub

Private Sub Form_Activate()

Call pausa 'llama al procedimiento

Label1.Visible = True

Call pausa

Label2.Visible = True

call pausa

Label3.Visible = True

Call pausa

Label4.Visible = True

Call pausa

Label5.Visible = True

End Sub

El código puede bajarse de Aquí.

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Command1_Click()

Call Sleep(1000) Beep

Call Sleep(3000) Beep

End Sub

El código puede bajarse de AQUÍ.

Option Explicit

Dim imagen As Integer

Dim Moviendo As Boolean

'Aquí establecemos las constantes de máximo y mínimo

Const MaxSlider1 = 6

Const MinSlider1 = 1

Private Sub Form_Load()

Moviendo = False

lblMin = MinSlider1

lblMax = MaxSlider1

lblValor = MinSlider1

End Sub

Private Sub imgPuntero_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim Cursor As POINTAPI

Dim Anterior As Long

Do 'Para que no lo actualize si no cambio

Anterior = Cursor.X

Moviendo = True

'Cargo la posicion del mouse

Call GetCursorPos(Cursor)

Cursor.X = Cursor.X - (Form1.Left / Screen.TwipsPerPixelX) - imgPuntero.Width

'Si no cambio, y no sale de los bordes de la barra, entonces...

If (Anterior <> Cursor.X) And (Cursor.X >= imgBarra.Left) And (Cursor.X + imgPuntero.Width <= imgBarra.Left + imgBarra.Width) Then

imgPuntero.Left = Cursor.X

End If

lblValor = Int((imgPuntero.Left - imgBarra.Left) * (MaxSlider1 - MinSlider1) / (imgBarra.Width - imgPuntero.Width)) + MinSlider1

Call mostrar

'Que haga los eventos para ver si hay MouseUp

DoEvents

Loop Until

Moviendo = False

End

Sub Private Sub imgPuntero_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

Moviendo = False

End Sub

Private Sub mostrar() If lblValor = 1 Then

Picture1.Picture = Image1(0).Picture

ElseIf lblValor = 3 Then

Picture1.Picture = Image1(1).Picture

ElseIf lblValor = 5 Then

Picture1.Picture = Image1(2).Picture

End If

End Sub

Modulo:

Option Explicit

Type POINTAPI X As Long Y As Long End Type

Declare Sub GetCursorPos Lib "User32" (lpPoint As POINTAPI)

El código puede bajarse de AQUÍ.

Option Explicit

Private Sub Slider1_Change()

Label1.Caption = "Medida en Centímetros = " & Format(Slider1.Value, "#.00")

End Sub

Private Sub Slider1_Scroll()

Label1.Caption = "Medida en Centímetros = " & Format(Slider1.Value, "#.00")

End Sub

El código puede bajarse desde AQUÍ.

Los controles que usamos son: un Media palyer, los tres controles tipicos para manipular archivos : DriveListBox, el DirListBox y el FileListBox, dos botones y dos labels con un timer que daran cuenta del tiempo total y parcial del archivo. El código es:

Option Explicit
Dim Min As Integer
Dim Sec As Integer
Dim Nombrearchivo As String
Dim Abrirarchivo As Boolean

Private Sub Command2_Click()'Boton salir
End
End Sub

Private Sub Command4_Click()'Boton Abrir y cerrar el archivo MP3
With MediaPlayer1
If Not Abrirarchivo Then
.FileName = Nombrearchivo
.AutoStart = False
Command4.Caption = "Cerrar"
Else
.FileName = ""
Command4.Caption = "Abrir"
End If
End With
End Sub

Private Sub Dir1_Change()'selecciona el directorio
File1.FileName = Dir1.Path
End Sub

Private Sub File1_Click()'selecciona el archivo MP3
If Right(Dir1.Path, 1) = "\" Then
Nombrearchivo = Dir1.Path & File1.FileName
Else
Nombrearchivo = Dir1.Path & "\" & File1.FileName
End If
End Sub

Private Sub MediaPlayer1_OpenStateChange(ByVal OldState As Long, ByVal NewState As Long)'mide el tiempo total de duración del archivo
Min = MediaPlayer1.Duration \ 60
Sec = MediaPlayer1.Duration - (Min * 60)
Label7.Caption = "Tiempo Total: " & Format(Min, "0#") & ":" & Format(Sec, "0#")
Abrirarchivo = CBool(NewState)
End Sub

Private Sub Timer1_Timer()'con el timer actualiza la label de tiempo 'transcurrido
Min = MediaPlayer1.CurrentPosition \ 60
Sec = MediaPlayer1.CurrentPosition - (Min * 60)
If Min > 0 Or Sec > 0 Then
Label8.Caption = "Tiempo transcurrido: " & Format(Min, "0#") & ":" & Format(Sec, "0#")
Else
Label8.Caption = "Tiempo transcurrido: 00:00"
End If
End Sub

Para que muestre solo los archivos MP3 en la propiedad Pattern del FileListBox: ingresamos "*.MP3"

Ahora veremos modificaciones del tipo de letra, estilo y algunos métodos graficos, como líneas, rectángulos arcos y círculos. En el procedimiento Click del boton ingresamos el siguiente código:

Option Explicit
Dim smensaje As String
Dim HWidth As Integer
Dim HHeight As Integer

Private Sub Command1_Click()
Const pi = 3.141592654
'vamos a imprimir dos renglones con un saludo
Printer.Print "Hola soy Mirta"
Printer.Print "Estamos usando el Objeto Printer"
'si queremos imprimir en una nueva pagina usamos Printer.NewPage
'y para cerrar la impresión Printer.EndDoc

'si queremos cambiar la letra
Printer.FontName = "Tahoma"

' para modificar el tamaño
Printer.FontSize = 14

' y aqui otras variaciones de estilo
With Printer
Printer.Print "Impresión Normal"
.FontBold = True
Printer.Print "Estamos imprimiendo en Negrita"
.FontItalic = True
Printer.Print "Estamos imprimiendo en Negrita y Cursiva"
.FontBold = False
.FontItalic = False
.FontSize = 10
Printer.Print "Volvemos a la impresión Normal y Tamaño: 10"
End With

'para imprimir el número de página en el centro podemos usar el siguiente código
smensaje = "Página " & Printer.Page
HWidth = Printer.TextWidth(smensaje) / 2
HHeight = Printer.TextHeight(smensaje) / 2
Printer.CurrentX = Printer.ScaleWidth / 2 - HWidth
Printer.CurrentY = (Printer.ScaleHeight - HHeight) - 200
Printer.Print smensaje

'para imprimir funciones gráficas con el objeto printer
'Line: necesitamos valores para las dos coordenadas de inicio y de final de la recta
Printer.Line (4000, 2500)-(7000, 4000), vbRed
'usando la sintaxix B se convertira en un rectángulo
Printer.Line (3000, 4500)-(6000, 6000), vbBlue, B
'para un círculo
Printer.Circle (4000, 8000), 1000, vbGreen
'para un medio arco
Printer.Circle (8000, 8000), 1000, vbBlue, 0, pi
'si le damos valores negativos dibuja las líneas hacia el centro del círculo.
Printer.Circle (4000, 12000), 1000, vbRed, -1, -pi
'y para una elipse
Printer.Circle (8000, 12000), 1000, vbBlue, , , 0.5
Printer.EndDoc
End Sub

El código es:

Option Explicit
Private Sub Command1_Click()'boton de número al azar
Dim azar As Integer
Randomize
azar = Int(10 * Rnd) + 1
Label3.Caption = azar
End Sub

Private Sub Command2_Click()'número al azar entre dos valores
Dim azar As Integer
Dim rangomenor As Integer
Dim rangomayor As Integer
Randomize
rangomayor = CInt(Text2)
rangomenor = CInt(Text1)
azar = Int((rangomayor - rangomenor + 1) * Rnd + rangomenor)
Label4 = azar
End Sub

Private Sub Command3_Click()' raíz de un número
Dim numero As Integer
Dim raiz As Integer
raiz = CInt(Text3)
numero = CInt(Text4)
Label5.Caption = numero ^ (1 / raiz)
End Sub

Private Sub Command4_Click()'redondeo de un decimal
Dim numero
Dim decimales As Integer
numero = Text6
decimales = CInt(Text5)
Label10.Caption = Round(numero, decimales)
End Sub

Private Sub Form_Activate()
Text1.SetFocus
End Sub

Usamos tres labels informativas, y tres cajas de texto para ingresar los valores, un boton para ejecutar la función y una label para que nos devuelva el cálculo hecho. El código es:

Option Explicit
Dim capital As Currency
Dim interesmensual As Single
Dim cuotas As Long

Private Sub Command1_Click()
capital = Text1
interesmensual = Text2
cuotas = Text3
Label4.Caption = InteresCompuesto(capital, interesmensual, cuotas)
End Sub

Function InteresCompuesto(capital As Currency, interesmensual As Single, cuotas As Long) As Currency
Dim i As Long
Dim total As Currency
total = capital
For i = 1 To cuotas
total = total + (total * (interesmensual))
Next i
InteresCompuesto = total - capital
End Function

Los ejercicios con su código completo pueden bajarse de AQUÍ.

Dim Puntos As Byte
Public flag1 As Byte
Public flag2 As Byte

Private Sub ganar()
'Poner todas las imagenes invisibles
If ImageUno.Visible = False And ImageDos.Visible = False And ImageTres.Visible = False _
And ImageCuatro.Visible = False And ImageCinco.Visible = False And ImageSeis.Visible = False _
And ImageSiete.Visible = False And ImageOcho.Visible = False And ImageNueve.Visible = False _
And ImageCero.Visible = False Then
For I = 1 To 300
Beep
Next I
lblRespuesta.Visible = True
lblRespuesta.ZOrder 0
lblRespuesta.Caption = "¡Muy bien resuelta la Tabla! ¡FELICIDADES!"
End If
End Sub

Private Sub AniPushButton1_Click()
frmTablaDel_1.Hide
frmTablaSumaDel_2.Show
End Sub

Private Sub AniPushButton2_Click()
'Limpiar los resultados
img0.Picture = LoadPicture("")
img1.Picture = LoadPicture("")
img2.Picture = LoadPicture("")
img3.Picture = LoadPicture("")
img4.Picture = LoadPicture("")
img5.Picture = LoadPicture("")
img6.Picture = LoadPicture("")
img7.Picture = LoadPicture("")
img8.Picture = LoadPicture("")
img9.Picture = LoadPicture("")

'Poner los números en la bola
ImageUno.Visible = True
ImageDos.Visible = True
ImageTres.Visible = True
ImageCuatro.Visible = True
ImageCinco.Visible = True
ImageSeis.Visible = True
ImageSiete.Visible = True
ImageOcho.Visible = True
ImageNueve.Visible = True
ImageCero.Visible = True

'Inicializar la propiedad Tag
img0.Tag = "vacia"
img1.Tag = "vacia"
img2.Tag = "vacia"
img2.Tag = "vacia"
img4.Tag = "vacia"
img5.Tag = "vacia"
img6.Tag = "vacia"
img7.Tag = "vacia"
img8.Tag = "vacia"
img9.Tag = "vacia"

'Limpiar los CheckBox y la imagenes
Check1.Caption = ""
Check1.Visible = False

imgConejo.Visible = False

Check2.Caption = ""
Check2.Value = 0
imgOsito.Visible = False

Check3.Caption = ""
Check3.Value = 0
imgPato.Visible = False

Check4.Caption = ""
Check4.Value = 0
imgGato.Visible = False

Check5.Caption = ""
Check5.Value = 0
imgBug.Visible = False

Check6.Caption = ""
Check6.Value = 0
imgNiña.Visible = False

Check7.Caption = ""
Check7.Value = 0
imgOso.Visible = False

Check8.Caption = ""
Check8.Value = 0
imgAlce.Visible = False

Check9.Caption = ""
Check9.Value = 0
imgViejito.Visible = False

lblRespuesta.ZOrder 1 'pasar atrás el label

End Sub

Private Sub Check1_Click()
Check1.Value = 1
End Sub

Private Sub Check2_Click()
Check2.Value = 1
End Sub

Private Sub Check3_Click()
Check3.Value = 1
End Sub

Private Sub Check4_Click()
Check4.Value = 1
End Sub

Private Sub Check5_Click()
Check5.Value = 1
End Sub

Private Sub Check6_Click()
Check6.Value = 1
End Sub

Private Sub Check7_Click()
Check7.Value = 1
End Sub

Private Sub Check8_Click()
Check8.Value = 1
End Sub

Private Sub Check9_Click()
Check9.Value = 1
End Sub

Private Sub Command1_Click()
'Limpiar los resultados
img0.Picture = LoadPicture("")
img1.Picture = LoadPicture("")
img2.Picture = LoadPicture("")
img3.Picture = LoadPicture("")
img4.Picture = LoadPicture("")
img5.Picture = LoadPicture("")
img6.Picture = LoadPicture("")
img7.Picture = LoadPicture("")
img8.Picture = LoadPicture("")
img9.Picture = LoadPicture("")

'Poner los números en la bola
ImageUno.Visible = True
ImageDos.Visible = True
ImageTres.Visible = True
ImageCuatro.Visible = True
ImageCinco.Visible = True
ImageSeis.Visible = True
ImageSiete.Visible = True
ImageOcho.Visible = True
ImageNueve.Visible = True
ImageCero.Visible = True

'Inicializar la propiedad Tag
img0.Tag = "vacia"
img1.Tag = "vacia"
img2.Tag = "vacia"
img2.Tag = "vacia"
img4.Tag = "vacia"
img5.Tag = "vacia"
img6.Tag = "vacia"
img7.Tag = "vacia"
img8.Tag = "vacia"
img9.Tag = "vacia"

'Limpiar los CheckBox y la imagenes
Check1.Caption = ""
Check1.Value = 0
imgConejo.Visible = False

Check2.Caption = ""
Check2.Value = 0
imgOsito.Visible = False

Check3.Caption = ""
Check3.Value = 0
imgPato.Visible = False

Check4.Caption = ""
Check4.Value = 0
imgGato.Visible = False

Check5.Caption = ""
Check5.Value = 0
imgBug.Visible = False

Check6.Caption = ""
Check6.Value = 0
imgNiña.Visible = False

Check7.Caption = ""
Check7.Value = 0
imgOso.Visible = False

Check8.Caption = ""
Check8.Value = 0
imgAlce.Visible = False

Check9.Caption = ""
Check9.Value = 0
imgViejito.Visible = False

lblRespuesta.ZOrder 1 'pasar atrás el label

End Sub

Private Sub img0_DragDrop(Source As Control, X As Single, Y As Single)
flag2 = 2
If TypeOf Source Is Image Then
If img0.Tag = "vacia" And Source.Tag = "cero" Then
img0.Picture = LoadPicture(App.Path & "\#0.ico")
img0.Tag = "Correcta"
Source.Visible = False

If flag1 = 1 And flag2 = 2 Then 'Chequea si estan colocados los dos numeros
Check9.Caption = "Correcta"
Check9.Value = 1
imgViejito.Visible = True
End If

For I = 1 To 20
Beep
Next I
Call ganar
ElseIf img0.Tag = "vacia" And Source.Tag <> "cero" Then
MsgBox "Esa suma es incorrecta", vbCritical
End If
End If
End Sub

Private Sub img1_DragDrop(Source As Control, X As Single, Y As Single)
If TypeOf Source Is Image Then
If img1.Tag = "vacia" And Source.Tag = "dos" Then
img1.Picture = LoadPicture(App.Path & "\#2.ico")
img1.Tag = "Correcta"
Source.Visible = False

Check1.Caption = "Correcta"
Check1.Value = 1
Check1.Visible = True
imgConejo.Visible = True
For I = 1 To 20
Beep
Next I
Call ganar
ElseIf img1.Tag = "vacia" And Source.Tag <> "dos" Then
MsgBox "Esa suma es incorrecta"
End If
End If
End Sub

Private Sub img2_DragDrop(Source As Control, X As Single, Y As Single)
If TypeOf Source Is Image Then
If img2.Tag = "vacia" And Source.Tag = "tres" Then
img2.Picture = LoadPicture(App.Path & "\#3.ico")
img2.Tag = "Correcta"
Source.Visible = False
Check2.Caption = "Correcta"
Check2.Value = 1
imgOsito.Visible = True
For I = 1 To 20
Beep
Next I
Call ganar
ElseIf img2.Tag = "vacia" And Source.Tag <> "tres" Then
MsgBox "Esa suma es incorrecta", vbCritical
End If
End If
End Sub

Private Sub img3_DragDrop(Source As Control, X As Single, Y As Single)
If TypeOf Source Is Image Then
If img3.Tag = "vacia" And Source.Tag = "cuatro" Then
img3.Picture = LoadPicture(App.Path & "\#4.ico")
img3.Tag = "Correcta"
Source.Visible = False
Check3.Caption = "Correcta"
Check3.Value = 1
imgPato.Visible = True
For I = 1 To 20
Beep
Next I
Call ganar
ElseIf img3.Tag = "vacia" And Source.Tag <> "cuatro" Then
MsgBox "Esa suma es incorrecta", vbCritical
End If
End If
End Sub

Private Sub img4_DragDrop(Source As Control, X As Single, Y As Single)
If TypeOf Source Is Image Then
If img4.Tag = "vacia" And Source.Tag = "cinco" Then
img4.Picture = LoadPicture(App.Path & "\#5.ico")
img4.Tag = "Correcta"
Source.Visible = False
Check4.Caption = "Correcta"
Check4.Value = 1
imgGato.Visible = True
For I = 1 To 20
Beep
Next I
Call ganar
ElseIf img4.Tag = "vacia" And Source.Tag <> "cinco" Then
MsgBox "Esa suma es incorrecta", vbCritical
End If
End If
End Sub

Private Sub img5_DragDrop(Source As Control, X As Single, Y As Single)
If TypeOf Source Is Image Then
If img5.Tag = "vacia" And Source.Tag = "seis" Then
img5.Picture = LoadPicture(App.Path & "\#6.ico")
img5.Tag = "Correcta"
Source.Visible = False
Check5.Caption = "Correcta"
Check5.Value = 1
imgBug.Visible = True
For I = 1 To 20
Beep
Next I
Call ganar
ElseIf img5.Tag = "vacia" And Source.Tag <> "seis" Then
MsgBox "Esa suma es incorrecta", vbCritical
End If
End If
End Sub

Private Sub img6_DragDrop(Source As Control, X As Single, Y As Single)
If TypeOf Source Is Image Then
If img6.Tag = "vacia" And Source.Tag = "siete" Then
img6.Picture = LoadPicture(App.Path & "\#7.ico")
img6.Tag = "Correcta"
Source.Visible = False
Check6.Caption = "Correcta"
Check6.Value = 1
imgNiña.Visible = True
For I = 1 To 20
Beep
Next I
Call ganar
ElseIf img6.Tag = "vacia" And Source.Tag <> "siete" Then
MsgBox "Esa suma es incorrecta", vbCritical
End If
End If
End Sub

Private Sub img7_DragDrop(Source As Control, X As Single, Y As Single)
If TypeOf Source Is Image Then
If img7.Tag = "vacia" And Source.Tag = "ocho" Then
img7.Picture = LoadPicture(App.Path & "\#8.ico")
img7.Tag = "Correcta"
Source.Visible = False
Check7.Caption = "Correcta"
Check7.Value = 1
imgOso.Visible = True
For I = 1 To 20
Beep
Next I
Call ganar
ElseIf img7.Tag = "vacia" And Source.Tag <> "ocho" Then
MsgBox "Esa suma es incorrecta", vbCritical
End If
End If
End Sub

Private Sub img8_DragDrop(Source As Control, X As Single, Y As Single)
If TypeOf Source Is Image Then
If img8.Tag = "vacia" And Source.Tag = "nueve" Then
img8.Picture = LoadPicture(App.Path & "\#9.ico")
img8.Tag = "Correcta"
Source.Visible = False
Check8.Caption = "Correcta"
Check8.Value = 1
imgAlce.Visible = True
For I = 1 To 20
Beep
Next I
Call ganar
ElseIf img8.Tag = "vacia" And Source.Tag <> "nueve" Then
MsgBox "Esa suma es incorrecta", vbCritical
End If
End If
End Sub

Private Sub img9_DragDrop(Source As Control, X As Single, Y As Single)
flag1 = 1 'Bandera
If TypeOf Source Is Image Then
If img9.Tag = "vacia" And Source.Tag = "uno" Then
img9.Picture = LoadPicture(App.Path & "\#1.ico")
img9.Tag = "Correcta"
Source.Visible = False

If flag1 = 1 And flag2 = 2 Then 'Chequea si estan colocados los dos numeros
Check9.Caption = "Correcta"
Check9.Value = 1
imgViejito.Visible = True
End If

For I = 1 To 20
Beep
Next I
Call ganar
ElseIf img9.Tag = "vacia" And Source.Tag <> "uno" Then
MsgBox "Esa suma es incorrecta", vbCritical
End If
End If
End Sub

Con esta aplicación simulamos la animación de llenar y vaciar un Tanque de Agua. Para que funcione correctamente este ejercicio, deben tener el control Gauge32 habilitado en su sistema de Windows.

El código es el siguiente:

Private Sub Slider1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
'Para cerrar con el label el agua de la llave
Static VolumenInicial As Integer
Static VolumenFinal As Integer
VolumenFinal = 10 - Slider1.Value

If VolumenFinal < VolumenInicial Then
lblAgua.Visible = True 'Cerrar la llave.
VolumenInicial = VolumenFinal
Else
lblAgua.Visible = False 'Abrir la llave.
VolumenInicial = VolumenFinal
End If
'Pasar el valor del Slider al TextBox
Text1.Text = 10 - (Slider1.Value)
End Sub

Private Sub Text1_Change()
'Si esta vacio el TextBox esperar entrar datos.
If Text1.Text = "" Then
Slider1.Value = 10 - Val(Text1.Text)
Gauge1.Value = 0
Text1.SetFocus
Exit Sub
End If
'Chequear el rango en que puede encontrarse el volumen.
If (Text1.Text > 10 Or Text1.Text < 0) Then
Slider1.Value = 0
Gauge1.Value = 0
MsgBox "El volumen debe estar entre 0 y 10 litros."
Else
'Pasar los valores del TextBox al control Slider y al Gauge.
Slider1.Value = 10 - Val(Text1.Text)
Gauge1.Value = Val(Text1.Text)
End If
End Sub

Private Sub Text1_Click()
'Para marcar el texto
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub

El ejercicio con su código completo puede bajarse de AQUÍ.

Private Sub cmdCalcular_Click()

del = (b ^ 2 - 4 * a * c)
If del >= 0 Then 'Si las raíces son reales e iguales
x1 = (-b + Sqr(del)) / (2 * a)
x2 = (-b - Sqr(del)) / (2 * a)
txtX1.Text = Format(x1, "###,##0.00")
txtX2.Text = Format(x2, "###,##0.00")
Else 'Si son complejas
x1 = Format((-b) / (2 * a), "###,##0.00")
x2 = Format((Sqr(-del)) / (2 * a), "###,##0.00")
txtX1.Text = x1 & " + " & x2 & " i"
txtX2.Text = x1 & " - " & x2 & " i"
End If
End Sub

Private Sub cmdSalir_Click()
End
End Sub

Private Sub Form_Load()
'Inicializar las variables
a = 1
b = 2
c = 1
'Inicializar las cajas de texto
txtA.Text = a
txtB.Text = b
txtC.Text = c
End Sub

Private Sub mnuAbrir_Click()
Dim Fichero As String 'Variable para el nombre del Fichero
CommonDialog1.Action = 1 'Ventana Abrir
Fichero = CommonDialog1.FileName
If Fichero = "" Then Exit Sub
Open Fichero For Random As #1 'Abrir el Fichero
'Tomar los valores del Fichero
Get #1, 1, a
Get #1, 2, b
Get #1, 3, c
Get #1, 4, x1
Get #1, 5, x2
Close #1
'Asignar los valores a las cajas de texto.
txtA.Text = a
txtB.Text = b
txtC.Text = c
cmdCalcular_Click 'Mandar a calcular
End Sub

Private Sub mnuSalvar_Click()
Dim Fichero As String
If Fichero = "" Then
mnuSalvarComo_Click
Exit Sub
End If
Open Fichero For Random As #1 'Abrir el Fichero.
'Guardar el valor de las variables en el Fichero.
Put #1, , a
Put #1, , b
Put #1, , c

Put #1, , x1
Put #1, , x2
Close (1)
End Sub

Private Sub mnuSalvarComo_Click()
Dim Fichero As String
CommonDialog1.Action = 2 'Abrir la ventana Salvar como.
Fichero = CommonDialog1.FileName
If Fichero = "" Then Exit Sub
Open Fichero For Random As #1 'Abrir el Fichero.
'Guardar el valor de las variables en el Fichero.
Put #1, , a
Put #1, , b
Put #1, , c
Put #1, , x1
Put #1, , x2
Close (1)
End Sub

Private Sub txtA_LostFocus()
If IsNumeric(txtA.Text) Then 'Si el dato es numérico
a = txtA.Text 'Asignar el valor del TextBox a la variable
Else
MsgBox "Valor incorrecto", vbInformation
txtA.SetFocus 'Poner el foco en el TextBox
End If
End Sub

Private Sub txtA_Change()
'Limpiar los resultados si hay un cambio de dato en el texto.
txtX1.Text = ""
txtX2.Text = ""
End Sub

Private Sub txtA_GotFocus()
'Seleccionar los textos
txtA.SelStart = 0
txtA.SelLength = Len(txtA.Text)
End Sub

Private Sub txtB_Change()
txtX1.Text = ""
txtX2.Text = ""
End Sub

Private Sub txtB_GotFocus()
txtB.SelStart = 0
txtB.SelLength = Len(txtB.Text)
End Sub

Private Sub txtB_LostFocus()
If IsNumeric(txtB.Text) Then
b = txtB.Text
Else
MsgBox "Valor incorrecto", vbInformation
txtB.SetFocus
End If
End Sub

Private Sub txtC_Change()
txtX1.Text = ""
txtX2.Text = ""
End Sub

Private Sub txtC_GotFocus()
txtC.SelStart = 0
txtC.SelLength = Len(txtC.Text)
End Sub

Private Sub txtC_LostFocus()
If IsNumeric(txtC.Text) Then
c = txtC.Text
Else
MsgBox "Valor incorrecto", vbInformation
txtC.SetFocus
End If
End Sub

El ejercicio con su código completo puede bajarse de AQUÍ.

Private Sub cmdSalir_Click()
End
End Sub

El ejercicio con su código completo puede bajarse de AQUÍ.

Private Sub cmdCalcular_Click()
'Multiplicando la cantidad por el precio y sumando para hallar el total.
Total = (CantidadHamburguesa * Hamburguesa) + (CantidadHotDog * HotDog) + _
(CantidadSandwich * Sandwich) + (CantidadGaseosa * Gaseosa) + _
(CantidadRefresco * Refresco) + (CantidadPapasFritas * PapasFritas)
lblTotal.Caption = "$ " & Total
End Sub

Private Sub cmdSalir_Click()
End
End Sub

Private Sub Form_Load()
'Inicializar las variables
'Precio de los productos
Hamburguesa = 20.5
HotDog = 19.25
Sandwich = 17.5
PapasFritas = 4.5
Refresco = 4
Gaseosa = 5
End Sub

Private Sub optOtroPedido_Click()
'Limpiar el label lblTotal.
lblTotal.Caption = ""

'Inicializar las variables.
CantidadHamburguesa = 0
CantidadGaseosa = 0
CantidadPapasFritas = 0
CantidadHotDog = 0
CantidadSandwich = 0
CantidadRefresco = 0

'Habilitar todas las cajas de texto para poder entrar datos en todas.
txtHamburguesa.Enabled = True
txtHotDog.Enabled = True
txtSandwich.Enabled = True
txtGaseosa.Enabled = True
txtRefresco.Enabled = True
txtPapasFritas.Enabled = True

'Limpiar todas las cajas de texto.
txtHamburguesa.Text = ""
txtHotDog.Text = ""
txtSandwich.Text = ""
txtGaseosa.Text = ""
txtRefresco.Text = ""
txtPapasFritas.Text = ""
End Sub

Private Sub optPedido1_Click()
'Hamburguesas,Gaseosa y Papas Fritas.
'Limpiar el label lblTotal.
lblTotal.Caption = ""

If optPedido1.Value Then 'si esta chequeado.
'Inicializar las variables.
CantidadHamburguesa = 1
CantidadGaseosa = 1
CantidadPapasFritas = 1
CantidadHotDog = 0
CantidadSandwich = 0
CantidadRefresco = 0

'Inicializar la caja de texto.
txtHamburguesa.Text = CantidadHamburguesa
txtGaseosa.Text = CantidadGaseosa
txtPapasFritas.Text = CantidadPapasFritas

'Habilitar las cajas de texto.
txtHamburguesa.Enabled = True
txtGaseosa.Enabled = True
txtPapasFritas.Enabled = True

'Deshabilitar las otras cajas de texto.
txtHotDog.Enabled = False
txtSandwich.Enabled = False
txtRefresco.Enabled = False

'Limpiar las otras cajas de texto.
txtHotDog.Text = ""
txtSandwich.Text = ""
txtRefresco.Text = ""
End If
End Sub

Private Sub optPedido2_Click()
'HotDog,Gaseosa y Papas Fritas.
'Limpiar el label lblTotal.
lblTotal.Caption = ""

If optPedido2.Value Then
'Inicializar las variables.
CantidadHotDog = 1
CantidadGaseosa = 1
CantidadPapasFritas = 1
CantidadHamburguesa = 0
CantidadSandwich = 0
CantidadRefresco = 0

'Inicializar la caja de texto.
txtHotDog.Text = CantidadHotDog
txtGaseosa.Text = CantidadGaseosa
txtPapasFritas.Text = CantidadPapasFritas

'Habilitar las cajas de texto.
txtHotDog.Enabled = True
txtGaseosa.Enabled = True
txtPapasFritas.Enabled = True

'Deshabilitar las otras cajas de texto.
txtHamburguesa.Enabled = False
txtSandwich.Text = False
txtRefresco.Text = False

'Limpiar las otras cajas de texto.
txtHamburguesa.Text = ""
txtSandwich.Text = ""
txtRefresco.Text = ""
End If
End Sub

Private Sub optPedido3_Click()
'Sanwich,Gaseosa y Papas Fritas.
'Limpiar el label lblTotal
lblTotal.Caption = ""

If optPedido3.Value Then
'Inicializar las variables
CantidadSandwich = 1
CantidadGaseosa = 1
CantidadPapasFritas = 1
CantidadHamburguesa = 0
CantidadHotDog = 0
CantidadRefresco = 0

'Inicializar la caja de texto
txtSandwich.Text = CantidadSandwich
txtGaseosa.Text = CantidadGaseosa
txtPapasFritas.Text = CantidadPapasFritas

'Habilitar las cajas de texto
txtSandwich.Enabled = True
txtGaseosa.Enabled = True
txtPapasFritas.Enabled = True

'Deshabilitar las otras cajas de texto.
txtHotDog.Enabled = False
txtHamburguesa.Enabled = False
txtRefresco.Enabled = False

'Limpiar las otras cajas de texto.
txtHotDog.Text = ""
txtHamburguesa.Text = ""
txtRefresco.Text = ""
End If
End Sub

Private Sub txtHamburguesa_Change()
'Limpiando el lblTotal.
lblTotal.Caption = ""
End Sub

Private Sub txtHamburguesa_GotFocus()
txtHamburguesa.SelStart = 0
txtHamburguesa.SelLength = Len(txtHamburguesa.Text)
End Sub

Private Sub txtHamburguesa_LostFocus()
If txtHamburguesa.Text = "" Then
CantidadHamburguesa = 0
Exit Sub
End If
If IsNumeric(txtHamburguesa.Text) Then 'Si es numérico.
If txtHamburguesa.Text > 0 Then 'Si es positivo.
CantidadHamburguesa = txtHamburguesa.Text 'Entonces asigna el valor a la variable.
Else
MsgBox "Entre un valor positivo", vbCritical
txtHamburguesa.SetFocus
End If
Else
MsgBox "Entre un valor numérico", vbCritical
txtHamburguesa.SetFocus
End If
End Sub

Private Sub txtGaseosa_Change()
lblTotal.Caption = ""
End Sub

Private Sub txtGaseosa_GotFocus()
'Para seleccionar el texto(igual en todos).
txtGaseosa.SelStart = 0
txtGaseosa.SelLength = Len(txtGaseosa.Text)
End Sub

Private Sub txtGaseosa_LostFocus()
If txtGaseosa.Text = "" Then
CantidadGaseosa = 0
Exit Sub
End If
If IsNumeric(txtGaseosa.Text) Then 'Si es numérico.
If txtGaseosa.Text > 0 Then 'Si es positivo.
CantidadGaseosa = txtGaseosa.Text 'Entonces asigna el valor a la variable.
Else
MsgBox "Entre un valor positivo", vbCritical
txtGaseosa.SetFocus
End If
Else
MsgBox "Entre un valor numérico", vbCritical
txtGaseosa.SetFocus
End If
End Sub

Private Sub txtHotDog_Change()
lblTotal.Caption = ""
End Sub

Private Sub txtHotDog_GotFocus()
txtHotDog.SelStart = 0
txtHotDog.SelLength = Len(txtHotDog.Text)
End Sub

Private Sub txtHotDog_LostFocus()
If txtHotDog.Text = "" Then
CantidadHotDog = 0
Exit Sub
End If
If IsNumeric(txtHotDog.Text) Then 'Si es numérico.
If txtHotDog.Text > 0 Then 'Si es positivo.
CantidadHotDog = txtHotDog.Text 'Entonces asigna el valor a la variable.
Else
MsgBox "Entre un valor positivo", vbCritical
txtHotDog.SetFocus
End If
Else
MsgBox "Entre un valor numérico", vbCritical
txtHotDog.SetFocus
End If
End Sub

Private Sub txtPapasFritas_Change()
lblTotal.Caption = ""
End Sub

Private Sub txtPapasFritas_GotFocus()
txtPapasFritas.SelStart = 0
txtPapasFritas.SelLength = Len(txtPapasFritas.Text)
End Sub

Private Sub txtPapasFritas_LostFocus()
If txtPapasFritas.Text = "" Then
CantidadPapasFritas = 0
Exit Sub
End If
If IsNumeric(txtPapasFritas.Text) Then 'Si es numérico.
If txtPapasFritas.Text > 0 Then 'Si es positivo.
CantidadPapasFritas = txtPapasFritas.Text 'Entonces asigna el valor a la variable.
Else
MsgBox "Entre un valor positivo", vbCritical
txtPapasFritas.SetFocus
End If
Else
MsgBox "Entre un valor numérico", vbCritical
txtPapasFritas.SetFocus
End If
End Sub

Private Sub txtRefresco_Change()
lblTotal.Caption = ""
End Sub

Private Sub txtRefresco_GotFocus()
txtRefresco.SelStart = 0
txtRefresco.SelLength = Len(txtRefresco.Text)
End Sub

Private Sub txtRefresco_LostFocus()
If txtRefresco.Text = "" Then
CantidadRefresco = 0
Exit Sub
End If
If IsNumeric(txtRefresco.Text) Then 'Si es numérico.
If txtRefresco.Text > 0 Then 'Si es positivo.
CantidadRefresco = txtRefresco.Text 'Entonces asigna el valor a la variable.
Else
MsgBox "Entre un valor positivo", vbCritical
txtRefresco.SetFocus
End If
Else
MsgBox "Entre un valor numérico", vbCritical
txtRefresco.SetFocus
End If
End Sub

Private Sub txtSandwich_Change()
lblTotal.Caption = ""
End Sub

Private Sub txtSandwich_GotFocus()
txtSandwich.SelStart = 0
txtSandwich.SelLength = Len(txtSandwich.Text)
End Sub

Private Sub txtSandwich_LostFocus()
If txtSandwich.Text = "" Then
CantidadSandwich = 0
Exit Sub
End If
If IsNumeric(txtSandwich.Text) Then 'Si es numérico.
If txtSandwich.Text > 0 Then 'Si es positivo.
CantidadSandwich = txtSandwich.Text 'Entonces asigna el valor a la variable.
Else
MsgBox "Entre un valor positivo", vbCritical
txtSandwich.SetFocus
End If
Else
MsgBox "Entre un valor numérico", vbCritical
txtSandwich.SetFocus
End If
End Sub

El ejercicio con su código completo puede bajarse de Aquí

Private Sub Image10_DragDrop(Source As Control, X As Single, Y As Single)
If Source = Image1 Then
Image10 = Image1
Image1.Visible = False
End If
End Sub

Private Sub Image11_DragDrop(Source As Control, X As Single, Y As Single)
If Source = Image2 Then
Image11 = Image2
Image2.Visible = False
End If
End Sub

Private Sub Image12_DragDrop(Source As Control, X As Single, Y As Single)
If Source = Image3 Then
Image12 = Image3
Image3.Visible = False
End If
End Sub

Private Sub Image13_DragDrop(Source As Control, X As Single, Y As Single)
If Source = Image4 Then
Image13 = Image4
Image4.Visible = False
End If
End Sub

Private Sub Image14_DragDrop(Source As Control, X As Single, Y As Single)
If Source = Image5 Then
Image14 = Image5
Image5.Visible = False
End If
End Sub

Private Sub Image15_DragDrop(Source As Control, X As Single, Y As Single)
If Source = Image6 Then
Image15 = Image6
Image6.Visible = False
End If
End Sub

Private Sub Image16_DragDrop(Source As Control, X As Single, Y As Single)
If Source = Image7 Then
Image16 = Image7
Image7.Visible = False
End If
End Sub

Private Sub Image17_DragDrop(Source As Control, X As Single, Y As Single)
If Source = Image8 Then
Image17 = Image8
Image8.Visible = False
End If
End Sub

Private Sub Image18_DragDrop(Source As Control, X As Single, Y As Single)
If Source = Image9 Then
Image18 = Image9
Image9.Visible = False
End If
End Sub

Private Sub Label3_Click()
End
End Sub

El ejercicio con su código completo puede bajarse de Aquí

Private Sub cmdDetener_Click()
Timer1.Interval = 0
End Sub

Private Sub cmdIniciar_Click()
I = 0 'Inicializar el contador.
Timer1.Interval = 0 'Detener el cronometro
lblCronometro.Caption = "" 'Limpiar la etiqueta
Timer1.Interval = 1 'Iniciar el cronometro
End Sub

Private Sub cmdSalir_Click()
End
End Sub

Private Sub Timer1_Timer()
I = I + 1
Tiempo = Format(Int(I / 36000) Mod 24, "00") & ":" & _
Format(Int(I / 600) Mod 60, "00") & ":" & _
Format(Int(I / 10) Mod 60, "00") & ":" & _
Format(I Mod 10, "00")
lblCronometro.Caption = Tiempo
End Sub

El ejercicio con su código completo puede bajarse de Aquí

Dim x As Single, y As Single
x = picFigura.Width / 2
y = picFigura.Height / 2
picFigura.DrawWidth = 2 'Grueso del punto del centro.
picFigura.PSet (x, y) 'Poner un punto en el centro.
picFigura.DrawWidth = 1 'Restaurar el grueso para dibujar el círculo.
picFigura.Circle (x, y), 700 'Dibujar el círculo en el centro del Picture.
'Dibujar el radio.
picFigura.Line (x, y)-(600, 600)
'Colocar los letreros de la base.
picFigura.CurrentX = 1000
picFigura.CurrentY = 600
picFigura.Print "r"
'Situar la fórmula.
picFormula.CurrentX = 25
picFormula.CurrentY = 500
picFormula.FontBold = True
picFormula.FontSize = 12
picFormula.Print " Área = 3.14 x r ^ 2 "
End Sub
Sub Trapecio()
Call Limpiar
Call MostrarB1
Call MostrarH
Call CambiarLabels
picFigura.DrawStyle = 0 'Dibujar con líneas continuas.
'Dibuja las 4 líneas.
picFigura.Line (300, 1400)-(300, 300)
picFigura.Line -(1500, 300)
picFigura.Line -(2100, 1400)
picFigura.Line -(300, 1400)

'Colocar los letreros de altura.
picFigura.CurrentX = 100
picFigura.CurrentY = 700
picFigura.Print "h"
'Colocar los letreros de la base mayor.
picFigura.CurrentX = 1100
picFigura.CurrentY = 1450
picFigura.Print "B"
'Colocar los letreros de la base menor.
picFigura.CurrentX = 850
picFigura.CurrentY = 50
picFigura.Print "b"
'Situar la fórmula.
picFormula.CurrentX = 50
picFormula.CurrentY = 500
picFormula.FontBold = True
picFormula.FontSize = 12
picFormula.Print "Área = (B + b)h / 2 "
End Sub
Sub CambiarLabels()
lblB.Caption = "b="
lblH.Caption = "h="
End Sub

Sub Rombo()
Call Limpiar
picFigura.DrawStyle = 0 'Dibujar con líneas continuas.
'Dibuja las 4 líneas.
picFigura.Line (500, 850)-(1050, 100)
picFigura.Line -(1700, 850)
picFigura.Line -(1050, 1600)
picFigura.Line -(500, 850)
picFigura.DrawStyle = 2 'Dibujar la diagonales con líneas discontinuas.
'Dibujar diagonales
picFigura.Line (500, 850)-(1700, 850)
picFigura.Line (1050, 100)-(1050, 1600)
'Colocar los letreros de altura.
picFigura.CurrentX = 1200
picFigura.CurrentY = 650
picFigura.Print "d1"
'Colocar los letreros de la base.
picFigura.CurrentX = 1100
picFigura.CurrentY = 1050
picFigura.Print "d2"
'Situar la fórmula
picFormula.CurrentX = 60
picFormula.CurrentY = 500
picFormula.FontBold = True
picFormula.FontSize = 12
picFormula.Print "Área = (d1 x d2) / 2 "
End Sub
Sub OcultarH() 'Oculta lblH y txtH.
lblH.Visible = False
txtH.Visible = False
End Sub
Sub MostrarH() 'Muestra lblH y txtH.
lblH.Visible = True
txtH.Visible = True
End Sub
Sub Cuadrado()
Call Limpiar
Call CambiarLabels
picFigura.DrawStyle = 0 'Dibujar con líneas continuas.
'Dibuja las 4 líneas.

picFigura.Line (500, 300)-(1900, 1400), , B 'Dibuja un cuadrado dando los vértices opuestos.

'Colocar los letreros de altura.
picFigura.CurrentX = 300
picFigura.CurrentY = 700
picFigura.Print "b"
'Colocar los letreros de la base.
picFigura.CurrentX = 1100
picFigura.CurrentY = 1450
picFigura.Print "b"
'Situar la fórmula.
picFormula.CurrentX = 300
picFormula.CurrentY = 500
picFormula.FontBold = True
picFormula.FontSize = 12
picFormula.Print " Área = b ^ 2 "
End Sub

Sub Paralelogramo()
Call Limpiar
Call CambiarLabels
picFigura.DrawStyle = 0 'Dibujar con líneas continuas
'Dibuja las 4 líneas.
picFigura.Line (300, 1400)-(500, 300)
picFigura.Line -(2100, 300)
picFigura.Line -(1900, 1400)
picFigura.Line -(300, 1400)
'Dibujar la altura.
picFigura.DrawStyle = 2 'Dibujar con líneas punteadas la altura.
picFigura.Line (500, 300)-(500, 1400)
'Colocar los letreros de altura.
picFigura.CurrentX = 550
picFigura.CurrentY = 700
picFigura.Print "h"
'Colocar los letreros de la base.
picFigura.CurrentX = 1100
picFigura.CurrentY = 1450
picFigura.Print "b"
'Situar la fórmula
picFormula.CurrentX = 300
picFormula.CurrentY = 500
picFormula.FontBold = True
picFormula.FontSize = 12
picFormula.Print " Área = b x h "
End Sub
Sub Rectangulo()
Call Limpiar
picFigura.DrawStyle = 0 'Dibujar con líneas continuas
Call CambiarLabels
'Dibuja las 4 líneas.
picFigura.Line (300, 1400)-(300, 300)
picFigura.Line -(2100, 300)
picFigura.Line -(2100, 1400)
picFigura.Line -(300, 1400)
'Colocar los letreros de altura.
picFigura.CurrentX = 100
picFigura.CurrentY = 700
picFigura.Print "h"
'Colocar los letreros de la base.
picFigura.CurrentX = 1100
picFigura.CurrentY = 1450
picFigura.Print "b"
'Situar la fórmula
picFormula.CurrentX = 300
picFormula.CurrentY = 500
picFormula.FontBold = True
picFormula.FontSize = 12
picFormula.Print " Área = b x h "
End Sub
Sub Limpiar()
picFigura.Cls 'Limpiar el PictureBox para las figuras.
picFormula.Cls 'Limpiar PictureBox para la fórmula.
End Sub

Sub OcultarB1() 'Oculta lblB1 y txtB1.
lblB1.Visible = False
txtB1.Visible = False
End Sub

Sub MostrarB1() 'Muestra lblB1 y txtB1.
lblB1.Visible = True
txtB1.Visible = True
End Sub
Sub Triangulo()
Call Limpiar
picFigura.DrawStyle = 0 'Dibujar con líneas continuas.
Call CambiarLabels
'Dibuja las 3 líneas.
picFigura.Line (300, 1400)-(1600, 300)
picFigura.Line -(2100, 1400)
picFigura.Line -(300, 1400)
picFigura.DrawStyle = 2 'Dibujar la altura con líneas continuas.
'Dibuja la altura
picFigura.Line (1600, 300)-(1600, 1400)
'Colocar los letreros de altura.
picFigura.CurrentX = 1450
picFigura.CurrentY = 900
picFigura.Print "h"
'Colocar los letreros de la base.
picFigura.CurrentX = 1300
picFigura.CurrentY = 1450
picFigura.Print "b"
'Situar la fórmula
picFormula.CurrentX = 100
picFormula.CurrentY = 500
picFormula.FontBold = True
picFormula.FontSize = 12
picFormula.Print " Área=( b x h ) / 2"
End Sub

Private Sub cmdCalcular_Click()
fraResultados.Visible = True
Select Case Figura
Case "Triangulo"
Area = b * h / 2
Case "Paralelogramo"
Area = b * h
Case "Rectangulo"
Area = b * h
Case "Cuadrado"
Area = b ^ 2 'Usamos la misma variable b para el lado.
Case "Rombo"
Area = b * h / 2 'Usamos las mismas variables b y h para las diagonales.Cambiamos las etiquetas a d1 y d2.
Case "Trapecio"
Area = (B1 + b) * h / 2
Case "Circulo"
Area = Pi * b ^ 2 'Usamos la variable b por el radio.Cambiamos la etiqueta a r.
End Select
txtArea.Text = Area
End Sub

Private Sub cmdSalir_Click()
End
End Sub

Private Sub Form_Load()
'Inicializar las variables.
h = 1
b = 2
B1 = 1
'Inicializar las cajas de texto.
txtB.Text = b
txtH.Text = h
txtB1.Text = B1
End Sub

Private Sub optCirculo_Click()
If optCirculo.Value Then
Figura = "Circulo"
Call Circulo 'Dibuja el círculo.
End If
End Sub

Private Sub optCuadrado_Click()
If optCuadrado.Value Then
Figura = "Cuadrado"
Call OcultarB1 'Pone invisible lblB1 y txtB1 por no necesitarse para el cálculo.
Call OcultarH 'Pone invisible lblH y txtH por no necesitarse para el cálculo.
Call Cuadrado 'Dibuja el cuadrado.
fraDatos.Visible = True 'MostrarB1 los datos.
fraResultados.Visible = False 'OcultarB1 los resultados.
End If
End Sub

Private Sub optParalelogramo_Click()
If optParalelogramo.Value Then
Figura = "Paralelogramo"
Call Paralelogramo 'Dibuja el paralelogramo.
Call OcultarB1 'Pone invisible lblB1 y txtB1 por no necesitarse para el cálculo.
Call MostrarH 'Pone visible lblH y txtH.
fraDatos.Visible = True 'MostrarB1 los datos
fraResultados.Visible = False 'OcultarB1 los resultados
End If
End Sub

Private Sub optRectangulo_Click()
If optRectangulo Then
Figura = "Rectangulo"
Call Rectangulo 'Dibuja el rectángulo.
Call OcultarB1 'Pone invisible lblB1 y txtB1 por no necesitarse para el cálculo.
Call MostrarH 'Pone visible lblH y txtH.
fraDatos.Visible = True 'MostrarB1 los datos.
fraResultados.Visible = False 'OcultarB1 los resultados.
End If
End Sub

Private Sub optRombo_Click()
If optRombo.Value Then
Figura = "Rombo"
Call OcultarB1 'Pone invisible lblB1 y txtB1 por no necesitarse para el cálculo.
lblB.Caption = "d1=" 'Cambiar el valor del lblB.
lblH.Caption = "d2=" 'Cambiar el valor del lblH.
Call MostrarH 'Pone visible lblH y txtH.
Call Rombo 'Dibuja el rombo.
fraDatos.Visible = True 'MostrarB1 los datos.
fraResultados.Visible = False 'OcultarB1 los resultados.
End If
End Sub

Private Sub optTrapecio_Click()
If optTrapecio.Value Then
Figura = "Trapecio"
Call Trapecio 'Dibuja el trapecio.
fraDatos.Visible = True 'MostrarB1 los datos.
fraResultados.Visible = False 'OcultarB1 los resultados.
End If
End Sub

Private Sub optTriangulo_Click()
If optTriangulo.Value Then
Figura = "Triangulo"
Call OcultarB1 'Pone invisible lblB1 y txtB1 por no necesitarse para el cálculo.
Call MostrarH 'Pone visible lblH y txtH.
Call Triangulo 'Dibuja el triángulo por código.
fraDatos.Visible = True 'MostrarB1 los datos
fraResultados.Visible = False 'OcultarB1 los resultados
End If
End Sub

Private Sub txtB_LostFocus()
If IsNumeric(txtB.Text) Then 'Cheque si el valor es numérico.
If txtB.Text > 0 Then 'Chequea si es mayor que cero.
b = txtB.Text 'Asigna el valor del texto a la variable.
Else 'Si no cumple lo anterior.
MsgBox "Valor incorrecto,debe ser mayor que cero", vbCritical
txtB.SetFocus 'Situa el foco en el TexBox txtB.
End If
Else 'Si no es numérico el dato.
MsgBox "El valor debe ser mayor que cero", vbCritical
txtB.SetFocus 'Situa el foco en el TexBox txtB.
End If
End Sub

Private Sub txtB1_LostFocus()
If IsNumeric(txtB1.Text) Then 'Cheque si el valor es numérico.
If txtB1.Text > 0 Then 'Chequea si es mayor que cero.
B1 = txtB1.Text 'Asigna el valor del texto a la variable.
Else 'Si no cumple lo anterior.
MsgBox "Valor incorrecto,debe ser mayor que cero", vbCritical
txtB1.SetFocus 'Situa el foco en el TexBox txtB1.
End If
Else 'Si no es numérico el dato.
MsgBox "El valor debe ser mayor que cero", vbCritical
txtB1.SetFocus 'Situa el foco en el TexBox txtB1.
End If
End Sub

Private Sub txtH_LostFocus()
If IsNumeric(txtH.Text) Then 'Cheque si el valor es numérico.
If txtH.Text > 0 Then 'Chequea si es mayor que cero.
h = txtH.Text 'Asigna el valor del texto a la variable.
Else 'Si no cumple lo anterior.
MsgBox "Valor incorrecto,debe ser mayor que cero", vbCritical
txtH.SetFocus 'Situa el foco en el TexBox txtH.
End If
Else 'Si no es numérico el dato.
MsgBox "El valor debe ser mayor que cero", vbCritical
txtH.SetFocus 'Situa el foco en el TexBox txtH.
End If
End Sub

El código completo puede bajarse de AQUÍ.

Para el formulario de presentación:

Option Explicit
Dim a As Integer
Dim tiempo As Integer

Private Sub Timer1_Timer()
tiempo = tiempo + 1

If tiempo = 30 Then
Form1.Show
Unload Form2
End If

Picture7 = Picture8(a)
Picture7.Move Picture7.Left + 200, Picture7.Top + 100
If a >= 2 Then a = 0

Picture6 = Picture5(a)
Picture6.Move Picture6.Left - 200, Picture6.Top + 100
If a >= 2 Then a = 0

Picture1 = Picture2(a)
Picture1.Move Picture1.Left - 200, Picture1.Top - 100
If a >= 2 Then a = 0

Picture3 = Picture4(a)
Picture3.Move Picture3.Left + 200, Picture3.Top - 100
If a >= 2 Then a = 0

If tiempo = 5 Then
Label5.Visible = True
ElseIf tiempo = 7 Then
Label6.Visible = True
ElseIf tiempo = 11 Then
Label1.Visible = True
ElseIf tiempo = 13 Then
Label2.Visible = True
ElseIf tiempo = 15 Then
Label3.Visible = True
ElseIf tiempo = 16 Then
Label4.Visible = True
End If
a = a + 1

End Sub

Para el segundo formulario:

Option Explicit
Public Bandera As Long 'Para contar las veces que se hace click
'sobre las figuras.
Dim Figura(8) As String 'Para guardar las figuras concordantes.
Dim Chequear As String 'Para contar las figuras durante la reconstrucción.
Dim ctlPrimeraFigura As Control 'Variables de control para la primera
Dim ctlSegundaFigura As Control 'y el segunda figura.
Dim UnoMostrado As Boolean 'Para llevar la cuenta de los mostrados.
Dim AmbosMostrados As Boolean
Dim Pares As Integer 'Lleva la cuenta de los pares.
Dim Segundos As Long 'Para llevar el tiempo.
Dim Puntuacion As Integer 'Para llevar la puntuación.
Dim Inicio As Date
Dim I As Integer

Sub FigurasVisibles()
'Hace todas las Figuras visibles
For I = 1 To 16
picFigura(I - 1).Visible = True
Next I
End Sub

Sub VoltearImagen()
'Voltea las imagenes cargando al Picture picVoltear.
For I = 1 To 16
picFigura(I - 1).Picture = picVoltear.Picture
Next I
End Sub

Sub HabilitarTodos()
'Habilita todas las Figuras.
For I = 1 To 16
picFigura(I - 1).Enabled = True
Next I
End Sub

Sub Verificar() 'Para ver si las dos figuras son iguales.
Dim I As Single
If ctlPrimeraFigura.Tag = ctlSegundaFigura.Tag Then 'Si las figuras coinciden
Pares = Pares + 1

For I = 1 To 10000 'para mostrar las dos figuras un tiempo.
ctlPrimeraFigura.Visible = False
ctlSegundaFigura.Visible = False
Next

If Pares = 8 Then 'Si se terminó el juego.
Timer2.Enabled = False 'Inhabilitar el reloj.
lblTiempo.Caption = CStr(Abs(Segundos))

If Segundos < Puntuacion Then
MsgBox "Tiempo empleado: " & Segundos & " segundos " & Chr(10) & "Puntuacion : " & CStr(Bandera), vbInformation
mnuIniciar_Click
End If
End If
Else

AmbosMostrados = True

End If
End Sub
Sub ChequearFigura() 'Chequea si es la primera o segunda figura que se volteado.
If UnoMostrado Then 'si una figura esta visible.
Set ctlSegundaFigura = Screen.ActiveControl 'Activa la variable control.
Call Verificar
UnoMostrado = False
Else
Set ctlPrimeraFigura = Screen.ActiveControl 'Activa la variable control.
ctlPrimeraFigura.Enabled = False
UnoMostrado = True
End If
End Sub

Function MezclarFiguras() As Integer 'Genera un número aleatorio entre 0 y 7.
'para asignarlo a las figuras.
Dim iNumero 'Variable para los números aleatorios.

Do While True 'Continua generando mientras...
Randomize Timer 'Siembra en base al número de segundos desde media noche
iNumero = Int(8 * Rnd) 'Obtiene un número entre 0 y 7.

If InStr(Chequear, CStr(iNumero)) = 0 Then 'Si todavía no esta asignado
Chequear = Chequear & CStr(iNumero) 'lo añade a la cadena de revisión
Exit Do 'y lo devuelve.
End If
Loop 'En caso contrario, genera otro.

MezclarFiguras = iNumero
End Function

Private Sub Form_Load()
lblTiempo.Caption = ""
lblPuntuacion.Caption = ""
Segundos = 0

UnoMostrado = False
Puntuacion = 30000 'Como máxima a alcanzar.

'Inicializa el arreglo figuras.
Figura(0) = App.Path & "\" & "Babs.ico"
Figura(1) = App.Path & "\" & "Dalmat.ico"
Figura(2) = App.Path & "\" & "Bird4.ico"
Figura(3) = App.Path & "\" & "Cow.ico"
Figura(4) = App.Path & "\" & "Fish1.ico"
Figura(5) = App.Path & "\" & "Cat3.ico"
Figura(6) = App.Path & "\" & "Butterf3.ico"
Figura(7) = App.Path & "\" & "Bear1.ico"

mnuIniciar_Click 'Hacer click en el menu Inicio.
End Sub

Private Sub Frame1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Si ambas no son iguales se mantiene desplegadas un momento mientras no se mueva el mouse.
If AmbosMostrados Then
ctlPrimeraFigura.Enabled = True 'Habilita los controles.
ctlPrimeraFigura.Picture = picVoltear.Picture 'Los voltea.
ctlSegundaFigura.Picture = picVoltear.Picture
AmbosMostrados = False
End If
End Sub

Private Sub mnuIniciar_Click()
Inicio = Now 'Iniciar el tiempo.
MousePointer = 11 'reloj de arena.
Chequear = "" 'Vacia la cadena de revisión.
Call FigurasVisibles
Call VoltearImagen 'Voltea las figuras.
Call HabilitarTodos
picFigura(0).Tag = Figura(MezclarFiguras()) 'Llama a MezclarFiguras para
picFigura(1).Tag = Figura(MezclarFiguras()) 'un número aleatorio.
picFigura(2).Tag = Figura(MezclarFiguras()) 'lo usa como indice para asignar
picFigura(3).Tag = Figura(MezclarFiguras()) 'aleatoriamente imágenes del arreglo Figuras.
picFigura(4).Tag = Figura(MezclarFiguras())
picFigura(5).Tag = Figura(MezclarFiguras())
picFigura(6).Tag = Figura(MezclarFiguras())
picFigura(7).Tag = Figura(MezclarFiguras())

Chequear = "" 'Cadena de revisión vacía.

picFigura(8).Tag = Figura(MezclarFiguras())
picFigura(9).Tag = Figura(MezclarFiguras())
picFigura(10).Tag = Figura(MezclarFiguras())
picFigura(11).Tag = Figura(MezclarFiguras())
picFigura(12).Tag = Figura(MezclarFiguras())
picFigura(13).Tag = Figura(MezclarFiguras())
picFigura(14).Tag = Figura(MezclarFiguras())
picFigura(15).Tag = Figura(MezclarFiguras())

MousePointer = 0 'Devuelve el mousepointer a lo normal.
Segundos = 0 'Reajusta los segundos.
lblTiempo.Caption = ""
lblPuntuacion.Caption = "" 'Limpia la puntuación
Timer2.Enabled = True 'Habilitar el reloj.
Bandera = 0 'Inicializa el contador Bandera.
End Sub

Private Sub mnuSalir_Click()
End
End Sub

Private Sub picFigura_Click(Index As Integer)
Bandera = Bandera + 1 'Aumentar el contador.
lblPuntuacion.Caption = Bandera 'Colocar su valor en el label.
picFigura(Index).Picture = LoadPicture(picFigura(Index).Tag) 'Cargar la imagen.
Call ChequearFigura
End Sub

Private Sub Timer2_Timer()
Segundos = DateDiff("s", Inicio, Now) 'Asignar al label el tiempo total.
lblTiempo.Caption = Int(Segundos)
End Sub

El código completo puede bajarse de AQUÍ.