Private Sub cmdBorrarNota_Click()
Dim i As Integer, NotaInd As Integer
NotaInd = List1.ListIndex + 1 'Asigna el orden del elemento de la lista a una variable.
If List1.ListIndex = -1 Then 'Si no esta checheada la lista.
MsgBox "Haga click en la lista para borrar la nota"
Exit Sub
Else
List1.RemoveItem (List1.ListIndex) 'Borra de la Lista la Nota
Text1.Text = "" 'Limpia el texto.
'Eliminar la nota de indice (List1.ListIndex+1) y correr las notas
For i = NotaInd To N - 1
Nota(i) = Nota(i + 1)
Next i
N = N - 1 'actualizando número de notas por ser borrada una.

If N > 1 Then ReDim Preserve Nota(1 To N) 'Reajustando la dimensión del arreglo notas
Text2.Text = ""
End If
End Sub

Private Sub cmdEntrarNota_Click()
If Text1.Text = "" Then 'Si no se han introducido nota.
MsgBox "No se ha introducido una nota"
Text1.SetFocus
Exit Sub
End If
N = N + 1 'Inicializa el conteo de las notas entradas.
ReDim Preserve Nota(1 To N) 'Redimesiona el arreglo.
Nota(N) = Text1.Text 'Asigna el valor al arreglo.
List1.AddItem (Nota(N)) 'Añade la nota a la lista.
cmdEntrarNota.Enabled = False
End Sub

Private Sub cmdPromedio_Click()
Dim Suma As Single
Dim Promedio As Single
Dim J As Integer
If N = 0 Then 'Si el número de notas es cero.
MsgBox "No existen valores para promediar"
Exit Sub
End If
Suma = 0
For J = 1 To N 'Suma todas las notas
Suma = Suma + Nota(J)
Next J
Promedio = Suma / N
Text2.Text = Promedio
End Sub

Private Sub cmdSalir_Click()
End
End Sub

Private Sub Form_Activate()
Text1.SetFocus

End Sub

Private Sub Text1_Change()
cmdEntrarNota.Enabled = True
Text2.Text = ""
End Sub

Private Sub Text1_Click()
cmdEntrarNota.Enabled = True
End Sub

Private Sub Text1_GotFocus()
'Para Selelccionar el texto al hacer click en él.
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub

Private Sub Text1_LostFocus()
If IsNumeric(Text1.Text) Then 'Chequea si el valor es numérico.
If Text1.Text <= 0 Then 'Chequea si es mayor que cero.
MsgBox "Valor incorrecto,debe ser mayor que cero", vbCritical
Text1.SetFocus 'Situa el foco en el TexBox Text1.
End If
Else 'Si no es numérico el dato.
MsgBox "El valor debe ser mayor que cero", vbCritical
Text1.SetFocus 'Situa el foco en el TexBox Text1.
End If
End Sub

El ejercicio completo puede bajarse de AQUÍ.

Private Sub Command1_Click(Index As Integer)
'Como es un array de controles. Al copiar el primer botón y pegarlo
'le decimos que sí a la ventana que no dice si queremos crear
'un array de controles.
'A partir de ahora todos responden al mismo evento por eso los
'identificamos por la propiedad INDEX
Label1.Caption = "Hiciste Click en el Botón Nº " & Command1(Index).Caption
End Sub

El ejercicio completo puede bajarse de AQUÍ.

Private Sub txtB_Change(Index As Integer)
If IsNumeric(txtB(Index)) Then
txtC(Index) = Val(txtA(Index)) + Val(txtB(Index))
Else
txtC(Index) = "#######"
End If
End Sub

El ejercicio completo puede bajarse de AQUÍ.

Option Explicit
Dim i As Integer

Private Sub Command1_Click()
'X es 60 en este ejemplo
ImprimeLineas Text1, 60
End Sub

Private Sub ImprimeLineas(Texto As Object, Linea As Integer)
Dim Bloque As String
'Número de caracteres = NumC
'Número de Bloques= NumB
Dim NumC, NumB As Integer
NumC = Len(Texto.Text)
If NumC > Linea Then
NumB = NumC \ Linea
For i = 0 To NumB
Texto.SelStart = (Linea * 1)
Texto.SelLength = Linea
Bloque = Texto.SelText
Printer.Print Bloque
Next i
Else
Printer.Print Texto.Text
End If
Printer.EndDoc
End Sub

Private Sub Command2_Click()
End
End Sub

El ejercicio completo puede bajarse de AQUÍ.

Dim tipo As Byte
Dim Orden As String

Private Sub Command1_Click()
Dim N As Long
DBGrid1.Visible = True
N = Text1.Text 'Para entrar el número de registros.

Select Case tipo
Case 1
Orden = "DESC"
Case 2
Orden = "ASC"
End Select

'Selecciona a partir de los últimos.
Data1.RecordSource = "SELECT TOP " & N & " * " & _
"FROM Empleados " & _
"ORDER BY IdEmpleado " & Orden
Data1.Refresh
End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Form_Load()
N = 3
Text1.Text = 3
Oden = "ASC"
optAscendente_Click
End Sub

Private Sub optAscendente_Click()
If optAscendente.Value Then tipo = 1
DBGrid1.Visible = False
End Sub

Private Sub Option1_Click()

End Sub

Private Sub optDescendente_Click()
If optDescendente.Value Then tipo = 2
DBGrid1.Visible = False
End Sub

Private Sub Text1_Change()
DBGrid1.Visible = False
End Sub

Private Sub Text1_Click()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub

Private Sub Text1_LostFocus()
If IsNumeric(Text1.Text) Then
If ((Text1.Text) >= 1 And (Text1.Text) <= 9) Then
N = Text1.Text
Else
MsgBox "El número de registros debe estar entre 1 y 9", vbInformation
Text1.SetFocus
End If
Else
MsgBox "Entre un valor numérico entre 1 y 9"
Text1.SetFocus
End If
End Sub

Dim Numero As Single
Dim Decimales As Long

Function RedondearNumero(ByVal Valor As Variant, ByVal Decimales As Integer) As Double

Dim Numero1 As Double
Dim Numero2 As Double
Dim Numero3 As Double
Dim Numero4 As Double
Dim Frac As Double
Dim n As Byte
n = InStr(1, Text1.Text, ".") 'posición en que se encuentra el punto decimal
n = Len(Mid(Text1.Text, n + 1)) 'longitud de la cadena de los decimales
If Decimales < n Then 'Si el dato de decimales es menor que el No. de decimales del número
Frac = 10 ^ Decimales
Numero1 = Valor * Frac
Numero2 = Fix(Valor * -Frac) * -1
Numero3 = Numero1 - Numero2
If Numero3 >= 0.5 Then
Numero4 = Int(Numero1 * -1) * -1
Else
Numero4 = Fix(Numero1 * -1) * -1
End If
RedondearNumero = Numero4 / Frac
Else
RedondearNumero = Val(Valor)
End If
End Function

Private Sub Command1_Click()
Label1.Caption = RedondearNumero(Numero, Decimales)
End Sub

Private Sub Form_Load()
Numero = 35.347239
Decimales = 2
Text1.Text = Numero
Text2.Text = Decimales
End Sub

Private Sub Text1_Change()
If Text1.Text = "" Then Exit Sub
If IsNumeric(Text1.Text) Then
Numero = Text1.Text
Label1.Caption = RedondearNumero(Numero, Decimales)
Else
MsgBox "El número debe ser positivo", vbInformation
Text1.SetFocus
End If
End Sub

Private Sub Text2_Change()
If Text2.Text = "" Then
Label1.Caption = ""
Exit Sub
End If
If IsNumeric(Text2.Text) Then
Decimales = Text2.Text
Label1.Caption = RedondearNumero(Numero, Decimales)
Else
MsgBox "El número debe ser positivo", vbInformation
Text2.SetFocus
End If
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
If (KeyAscii < 48) Or (KeyAscii > 57) Then 'Para solo permitir números del 0 al 9
If KeyAscii <> 8 Then KeyAscii = 0 'Para aceptar la tecla de retroceso
End If
End Sub

El código completo puede bajarse de AQUÍ.

Private Sub Form_Load()
' Este código crea un árbol con objetos Node.
TreeView1.Style = tvwTreelinesPlusMinusText ' Estilo 6.
TreeView1.LineStyle = tvwRootLines 'Estilo de línea 1.

' Agrega varios objetos Node.
Dim nodX As Node ' Crea variable.
'Nodo Principal con la Clave Provincia y el Nombre Provincias
Set nodX = TreeView1.Nodes.Add(, , "Provincia", "Provincias")
Set nodX = TreeView1.Nodes.Add(, , "MunicipioEspecial", "Municipio Especial")
Set nodX = TreeView1.Nodes.Add("MunicipioEspecial", tvwChild, "IslaJuventud", "Isla de la Juventud")
'Nodos Secundarios con el nombre de las provincias.
Set nodX = TreeView1.Nodes.Add("Provincia", tvwChild, "Pinar del Rio", "Pinar del Rio")
Set nodX = TreeView1.Nodes.Add("Provincia", tvwChild, "La Habana", "La Habana")
Set nodX = TreeView1.Nodes.Add("Provincia", tvwChild, "Ciudad Habana", "Ciudad Habana")
Set nodX = TreeView1.Nodes.Add("Provincia", tvwChild, "Matanzas", "Matanzas")
Set nodX = TreeView1.Nodes.Add("Provincia", tvwChild, "Villa Clara", "Villa Clara")
Set nodX = TreeView1.Nodes.Add("Provincia", tvwChild, "Cienfuegos", "Cienfuegos")
Set nodX = TreeView1.Nodes.Add("Provincia", tvwChild, "Santi Spiritus", "Santi Spiritus")
Set nodX = TreeView1.Nodes.Add("Provincia", tvwChild, "Ciego de Avila", "Ciego de Avila")
Set nodX = TreeView1.Nodes.Add("Provincia", tvwChild, "Camaguey", "Camaguey")
Set nodX = TreeView1.Nodes.Add("Provincia", tvwChild, "Las Tunas", "Las Tunas")
Set nodX = TreeView1.Nodes.Add("Provincia", tvwChild, "Holguin", "Holguin")
Set nodX = TreeView1.Nodes.Add("Provincia", tvwChild, "Granma", "Granma")
Set nodX = TreeView1.Nodes.Add("Provincia", tvwChild, "Santiago de Cuba", "Santiago de Cuba")
Set nodX = TreeView1.Nodes.Add("Provincia", tvwChild, "Guantanamo", "Guantanamo")
'Set nodX = TreeView1.Nodes.Add("Provincia", tvwChild, "Isla de la Juventud", "Isla de la Juventud")
nodX.EnsureVisible ' Muestra todos los nodos.
End Sub

Private Sub mnuNuevo_Click()
lblPinarDelRio.Visible = False
lblLaHabana.Visible = False
lblCiudadHabana.Visible = False
lblMatanzas.Visible = False
lblVillaClara.Visible = False
lblCienfuegos.Visible = False
lblSantiSpiritus.Visible = False
lblCiegoDeAvila.Visible = False
lblCamaguey.Visible = False
lblLasTunas.Visible = False
lblHolguin.Visible = False
lblGranma.Visible = False
lblSantiagoDeCuba.Visible = False
lblGuantanamo.Visible = False
lblIslaJuventud.Visible = False
End Sub

Private Sub mnuSalir_Click()
End
End Sub

Private Sub TreeView1_NodeClick(ByVal Node As Node)
Select Case Node
Case "Pinar del Rio"
lblPinarDelRio.Visible = True
Case "La Habana"
lblLaHabana.Visible = True
Case "Ciudad Habana"
lblCiudadHabana.Visible = True
Case "Matanzas"
lblMatanzas.Visible = True
Case "Villa Clara"
lblVillaClara.Visible = True
Case "Cienfuegos"
lblCienfuegos.Visible = True
Case "Santi Spiritus"
lblSantiSpiritus.Visible = True
Case "Ciego de Avila"
lblCiegoDeAvila.Visible = True
Case "Camaguey"
lblCamaguey.Visible = True
Case "Las Tunas"
lblLasTunas.Visible = True
Case "Holguin"
lblHolguin.Visible = True
Case "Granma"
lblGranma.Visible = True
Case "Santiago de Cuba"
lblSantiagoDeCuba.Visible = True
Case "Guantanamo"
lblGuantanamo.Visible = True
Case "Isla de la Juventud"
lblIslaJuventud.Visible = True

End Select

End Sub

El código completo puede bajarse de AQUÍ.

Private Sub Form_Load()
'La variable delta se usa para incrementar la x.
delta = 0.05 'Incremento de delta inicial para la velocidad del movimiento
End Sub

Private Sub Image1_Click()
Label1.Visible = False
'Ancho y Alto de la imagen.
w = Image1.Width
h = Image1.Height

Call Mover
End Sub

Private Sub mnIniciar_Click()
Label1.Visible = True
Image1.Enabled = True 'habilitar la imagen
'Llevar la imagen a la posición inicial.
Image1.Left = 420
Image1.Top = 3060
End Sub

Private Sub mnuSalir_Click()
End
End Sub

Private Sub optMediana_Click()
If optMediana.Value Then delta = 0.5
End Sub

Private Sub optPoca_Click()
If optPoca.Value Then delta = 0.05
End Sub

Private Sub optRapida_Click()
If optRapida.Value Then delta = 1
End Sub

El código de la aplicación puede bajarse de Aquí.

Private Sub Command1_Click()' Efecto estirado de la imagen
Dim i
For i = 1 To Picture1.ScaleWidth Step 3
Picture2.PaintPicture Picture1.Picture, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, 0, 0, i, Picture1.ScaleHeight, &HCC0020
Next i

End Sub

Private Sub Command2_Click()' Efecto persiana

Dim stripes As Integer
Dim i, j As Integer
Dim stripewidth As Integer

Picture2.Cls
stripewidth = 10
stripes = Fix(Picture1.ScaleWidth / stripewidth)

On Error Resume Next
For j = 1 To stripewidth
For i = 0 To stripes
Picture2.PaintPicture Picture1.Picture, i * stripewidth, 0, j, Picture1.ScaleHeight, i * stripewidth, 0, j, Picture1.ScaleHeight, &HCC0020
Next
Next
End Sub

Private Sub Command3_Click()'Efecto barrido desde la derecha

Dim PWidth, PHeight As Integer
Dim i As Integer
pw = 1
ph = Picture1.ScaleHeight

For i = 1 To Picture1.ScaleWidth / 2
Picture2.PaintPicture Picture1.Picture, (Picture1.ScaleWidth - pw) / 2, 0, pw, ph, (Picture1.ScaleWidth - pw) / 2, 0, pw, ph, &HCC0020
pw = pw + 2
Next i
End Sub

El código completo del ejercicio puede bajarse de Aquí.

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
CX = X
CY = Y

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label1.Caption = X
Label2.Caption = Y
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Line (CX, CY)-(X, Y)

End Sub

El código del ejercicio completo puede bajarse de Aquí.

Private Sub Image4_Click()
MousePointer = 99
MouseIcon = Image4
Image4.MouseIcon = Image4
Image4.Visible = False
End Sub

Private Sub Image6_Click()
MousePointer = 99
MouseIcon = Image6
Image6.MouseIcon = Image6
Image6.Visible = False
End Sub

Private Sub Image7_Click()
MousePointer = 99
MouseIcon = Image7
Image7.MouseIcon = Image7
Image7.Visible = False
End Sub

Private Sub Image8_Click()
MousePointer = 99
MouseIcon = Image8
Image8.MouseIcon = Image8
Image8.Visible = False
End Sub

Private Sub Image9_Click()
Form2.Show
Form1.Hide
End Sub

Private Sub mnuAyuda_Click()
MsgBox " Recogé los objetos posibles y colocálos en el Inventario por Orden Alfabético, haciéndo Click", , "Mini Aventura"
End Sub

Private Sub mnuReiniciar_Click()
Unload Form1
Unload Form2
Form1.Show
End Sub

Private Sub mnuSalir_Click()
End
End Sub

Private Sub Picture1_Click()
If MouseIcon = Image7 Then
Picture1 = Image7
MouseIcon = Nothing
Form2.Picture1.Picture = Image7
End If
End Sub

Private Sub Picture2_Click()
If MouseIcon = Image4 Then
Picture2 = Image4
MouseIcon = Nothing
Form2.Picture2.Picture = Image4
End If
End Sub

Private Sub Picture3_Click()
If MouseIcon = Image8 Then
Picture3 = Image8
MouseIcon = Nothing
Form2.Picture3.Picture = Image8
End If
End Sub

Private Sub Picture4_Click()
If MouseIcon = Image6 Then
Picture4 = Image6
MouseIcon = Nothing
Form2.Picture4.Picture = Image6
End If
End Sub

El código del segundo formulario es:

Option Explicit

Private Sub Image5_Click()
If MouseIcon = Picture1 Then
Image5 = Picture1
MouseIcon = Nothing
Image5.MouseIcon = Nothing
End If
Call corregir
End Sub

Private Sub Image6_Click()
If MouseIcon = Picture3 Then
Image6 = Picture3
MouseIcon = Nothing
Image6.MouseIcon = Nothing
End If
Call corregir
End Sub

Private Sub Image7_Click()
If MouseIcon = Picture4 Then
Image7 = Picture4
MouseIcon = Nothing
Image7.MouseIcon = Nothing
End If
Call corregir
End Sub

Private Sub Image8_Click()
If MouseIcon = Picture2 Then
Image8 = Picture2
MouseIcon = Nothing
Image8.MouseIcon = Nothing
End If
Call corregir
End Sub

Private Sub Image9_Click()
Form1.Show
Form2.Hide
End Sub

Private Sub mniSalir_Click()
End
End Sub

Private Sub mnuAtuda_Click()
MsgBox "Hacé Click en los Objetos del Inventario y Colocálos en los lugares correspondientes", , "Mini Aventura"
End Sub

Private Sub mnuReiniciar_Click()
Unload Form1
Unload Form2
Form1.Show
End Sub

Private Sub Picture1_Click()
MousePointer = 99
MouseIcon = Picture1
Picture1.MouseIcon = Picture1
Picture1.Visible = False
End Sub

Private Sub Picture2_Click()
MousePointer = 99
MouseIcon = Picture2
Picture2.MouseIcon = Picture2
Picture2.Visible = False
End Sub

Private Sub Picture3_Click()
MousePointer = 99
MouseIcon = Picture3
Picture3.MouseIcon = Picture3
Picture3.Visible = False
End Sub

Private Sub Picture4_Click()
MousePointer = 99
MouseIcon = Picture4
Picture4.MouseIcon = Picture4
Picture4.Visible = False
End Sub

Private Sub corregir()
If Image5 = Picture1 And Image8 = Picture2 And Image6 = Picture3 And Image7 = Picture4 Then
Label2 = "¡¡Correcto!! Completaste la Mini Aventura"
End If
End Sub

El código completo de la Aplicación puede bajarse de Aquí.

En este ejercicio vamos a usar una pequeña rutina de control de Errores. El objetivo es buscar en la Unidad A, un archivo determinado, en este caso un .wmf, si no lo encuentra despliega un mensaje, codificado en la rutina de Error.

El código es:

Private Sub Command1_Click()
On Error GoTo ErrorDisco
Image1.Picture = LoadPicture("a:\prntout2.wmf")
Exit Sub
ErrorDisco:
If Err.Number = 71 Then
MsgBox ("Por Favor, Cierre la puerta de la unidad."), , "Disco no preparado"
Resume
Else
MsgBox ("Imposible localizar prntout2.wmf en A:\."), , "Archivo no encontrado"
Resume FinPrueba
End If
FinPrueba:
End Sub

El código completo del ejercicio puede bajarse de Aquí.

El código completo es el siguiente:

Private Sub cmdInicio_Click()
Dim Extension As String
Busqueda = "." ' Busqueda hasta ".".
If InStr(1, File1.FileName, ".") Then 'Si encuentra el signo "."
'Comparacion
MiPos = InStr(File1.FileName, Busqueda) ' Regresa la posición de ".".
Extension = Mid(File1.FileName, MiPos + 1) 'Escribe extensión cortado despues del punto.
If Extension = "WAV" Or Extension = "wav" Then
MMControl1.FileName = Dir1.Path & "/" & File1.FileName
MMControl1.Command = "open"
MMControl1.Command = "play"
Else
MsgBox "Con esa extensión no puede oir esta musica," & _
"solo permite oir con extension WAV", vbInformation
End If
Else
Exit Sub
End If
End Sub

Private Sub cmdParar_Click()
MMControl1.Command = "stop"
MMControl1.Command = "close"
End Sub

Private Sub cmdPausa_Click()
MMControl1.Command = "pause"
End Sub

Private Sub Dir1_Change()
'Para que aparezcan sólo los archivos de ese directorio.
File1.Path = Dir1.Path
End Sub

Private Sub Form_Load()
MMControl1.DeviceType = "waveaudio"
MMControl1.Command = "close"
End Sub

El código completo de la Aplicación puede bajarse de Aquí.

Private Sub cmdInicio_Click()
Dim Extension As String
Busqueda = "." ' Busqueda hasta ".".
If InStr(1, File1.FileName, ".") Then 'Si encuentra el signo "."
'Comparacion
MiPos = InStr(File1.FileName, Busqueda) ' Regresa la posición de ".".
Extension = Mid(File1.FileName, MiPos + 1) 'Escribe extensión cortado despues del punto.
If Extension = "AVI" Then
MMControl1.FileName = Dir1.Path & "/" & File1.FileName
MMControl1.Command = "open"
MMControl1.Command = "play"
Else
MsgBox "Con esa extensión no pueden ver videos," & _
"solo permite ver con extension avi", vbInformation
End If
Else
Exit Sub
End If
End Sub

Private Sub cmdParar_Click()
MMControl1.Command = "stop"
MMControl1.Command = "close"
End Sub

Private Sub cmdPausa_Click()
MMControl1.Command = "pause"
End Sub

Private Sub Dir1_Change()
'Para que aparezcan sólo los archivos de ese directorio.
File1.Path = Dir1.Path
End Sub

Private Sub Form_Load()
MMControl1.DeviceType = "avivideo"
MMControl1.Command = "close"
MMControl1.hWndDisplay = Picture1.hWnd
End Sub

El código completo de la Aplicación puede bajarse de Aquí.

Option Explicit

Private Sub Command1_Click()
Dim cuotas As Currency
If Not CalcPago(CSng(Text1), Val(Text2), CSng(Text3), cuotas) Then
MsgBox "¡Qué escribiste!, ¡¡No puedo calcular eso!!"
Else ' resultado satisfactorio
Picture1.Visible = True
Label4.Caption = Format(cuotas, " #,##0.00;($#,##0.00)")
End If
End Sub

El código del Módulo es:

Option Explicit

Public Function CalcPago(capital As Currency, año As Integer, interes As Single, cuota As Currency) As Boolean

On Error GoTo repararerror
'dimensiona la variable como objeto
Dim excelapp As Object

' el tipo de apliación es Excel
Const hdExcelObject = "Excel.Application"
Screen.MousePointer = vbHourglass
CalcPago = False

' crea la aplicación en Excel donde se realizará el Cálculo
Set excelapp = CreateObject(hdExcelObject)

'llama al método pmt de Excel
cuota = excelapp.Pmt((interes / 100) / 12, año * 12, -1 * capital)
excelapp.quit
Set excelapp = Nothing
CalcPago = True
Screen.MousePointer = vbDefault
Exit Function

repararerror:
' determina el tipo de error
Select Case Err.Number
Case 429
MsgBox "Imposible crear un Aplicación OLE con Excel." + vbCrLf + " Está seguro de tener una Versión de Excel superior a la 5, y bien instalada?", vbCritical, "Cálculo de pago de Cuotas"
Case Else
MsgBox "Error #" + Str(Err.Number) + ":" + Err.Description + ".", vbCritical, "Cálculo de pago de Cuotas"
End Select
Screen.MousePointer = vbDefault
End Function

El código completo de la Aplicación puede bajarse de Aquí.

Option Explicit

Private Sub recuadro()
Dim i As Integer
Form1.ScaleMode = vbPixels
Form1.ForeColor = vbBlack
Const DrawWidth = 3
For i = DrawWidth - 1 To 6 * 6 Step 2
Form1.Line (i, i)-(Form1.ScaleWidth - 1 - i, Form1.ScaleHeight - 1 - i), , B
Next i
End Sub

Private Sub texto3d()
Dim X As Integer
Dim Y As Integer
X = 500
Y = 500
If Form1.ScaleMode <> vbTwips Then Form1.ScaleMode = vbTwips
Form1.ZOrder 0 'lo necesitamos para imprimir por arriba de lo existente
Form1.ForeColor = RGB(32, 32, 32) ' gris oscuro para las sombras
Form1.Font.Name = "Arial"
Form1.Font.Underline = True
Form1.FontSize = 38
Form1.CurrentX = X ' sitúa el cursor
Form1.CurrentY = Y
Form1.Print "Diseño y Programación:"
Form1.CurrentX = 1500

Form1.Print "Mirta Echeverría"
Form1.ForeColor = RGB(255, 255, 255) 'blanco para resaltar
Form1.CurrentX = X - 35 ' coloca la zona a resaltar en la parte superior izquierda
Form1.CurrentY = Y - 45
Form1.Print "Diseño y Programación:"
Form1.CurrentX = 1500

Form1.Print "Mirta Echeverría"
Form1.ForeColor = vbBlue
Form1.CurrentX = X - 25 ' imprime entre el resaltado y la sombra
Form1.CurrentY = Y - 35
Form1.Print "Diseño y Programación:" ' imprime en azul
Form1.CurrentX = 1500

Form1.Print "Mirta Echeverría"
End Sub

Private Sub Form_Load()
Call texto3d
Call recuadro
End Sub

El código completo de la Aplicación puede bajarse de Aquí.

En Option Explicit
Dim ladoA(1 To 10) As String
Dim ladoB(1 To 10) As String
Dim numcarta As Integer
Dim indice As Integer

Private Sub Command1_Click()
'mostrar el lado A de la carta siguiente.

'los botones de opcion seleccionan una carta secuencial o aleatoria
If Option1.Value = True Then
'incrementar el indice actual y comprobar si se encuentra dentro del intervalo de 1 a numcarta.
indice = indice + 1
If indice < 1 Or indice > numcarta Then
'si el indice está fuera del intérvalo, comenzar nuevamente.
indice = 1
End If
ElseIf Option2.Value = True Then
'carta aleatoria. indice aleatorio de 1 a numcaarta.
indice = Fix(numcarta * Rnd) + 1
End If

' mostrar el lado A y el número de carta, Borrar el lado B
Text3.Text = indice
Text1.Text = ladoA(indice)
Text2.Text = ""

' desactivar el botón lado A y activar el botón Lado B
Command1.Enabled = False
Command2.Enabled = True
End Sub

Private Sub Command2_Click()
'mostrar el lado B de la tarjeta actual
Text2.Text = ladoB(indice)

'activa el boton lado A y desactiva lado B
Command1.Enabled = True
Command2.Enabled = False
End Sub

Private Sub Command3_Click()
End
End Sub

Private Sub Form_Load()
' asignar valores a los arrays ladoA y ladoB
numcarta = 7
ladoA(1) = "Nihon´go"
ladoB(1) = "Idioma Japonés"
ladoA(2) = "Ohayo gozaimasu"
ladoB(2) = "Buenos Días"
ladoA(3) = "Ken´nichi wa"
ladoB(3) = "Hola o Buen Día"
ladoA(4) = "Kon´ban wa"
ladoB(4) = "Buenas Tardes"
ladoA(5) = "Oyasumi nasai"
ladoB(5) = "Buenas Noches"
ladoA(6) = "Ja, mata ashita"
ladoB(6) = "Bien, nos veremos mañana"
ladoA(7) = "Sayonara"
ladoB(7) = "Adiós"

'activar el botón ladoA y desactivar el ladoB
Command1.Enabled = True
Command2.Enabled = False
End Sub

El código completo de la Aplicación puede bajarse de Aquí.

Option Explicit

'Variables Globales
Dim puntaje As Integer
Dim contador As Integer
Dim dificultad As Integer
Dim menuchekeado As Menu

Private Sub Form_Load()
Call ComenzarJuego
End Sub

Private Sub mnuComenzar_Click()
Form1.Cls
Call DibujarPantalla
puntaje = 0
contador = 0
Timer1.Interval = dificultad
End Sub

Private Sub mnuDificil_Click()
dificultad = 500
menuchekeado.Checked = False
Set menuchekeado = mnuDificil
mnuDificil.Checked = True
End Sub

Private Sub mnuFacil_Click()
dificultad = 1000
menuchekeado.Checked = False
Set menuchekeado = mnuFacil
mnuFacil.Checked = True
End Sub

Private Sub mnuImposible_Click()
dificultad = 250
menuchekeado.Checked = False
Set menuchekeado = mnuImposible
mnuImposible.Checked = True
End Sub

Private Sub mnuModerado_Click()
dificultad = 700
menuchekeado.Checked = False
Set menuchekeado = mnuModerado
mnuModerado.Checked = True
End Sub

Private Sub mnusalir_Click()
Unload Form1
End Sub

Private Sub Picture1_Click()
If Timer1.Interval > 100 Then
Beep
puntaje = puntaje + 1
End If
End Sub

Private Sub Timer1_Timer()
Dim x As Integer, y As Integer
Dim BoxX As Integer, BoxY As Integer

x = Int(391 * Rnd + 20)
y = Int(231 * Rnd + 20)
BoxX = Picture1.Left
BoxY = Picture1.Top
Form1.ForeColor = RGB(Rnd * 256, Rnd * 256, Rnd * 256)
Form1.Line (BoxX, BoxY)-(BoxX + 100, BoxY + 100), , BF
Picture1.Move x, y
puntaje = puntaje + 1
If puntaje = 30 Then
Timer1.Interval = 0
MsgBox "Su puntaje: " & puntaje, , "¡Agárrame si puedes!"
End If
End Sub

Private Sub ComenzarJuego()
dificultad = 500
mnuModerado.Checked = True
Set menuchekeado = mnuModerado
Randomize
Call DibujarPantalla
Call DibujarCara
End Sub

Private Sub DibujarPantalla()
Form1.ForeColor = vbBlack
Form1.Line (10, 10)-(517, 10)
Form1.Line (10, 10)-(10, 358)
Form1.Line (522, 5)-(522, 362)
Form1.Line (522, 362)-(5, 362)
Form1.ForeColor = vbWhite
Form1.Line (5, 5)-(522, 5)
Form1.Line (5, 5)-(5, 363)
Form1.Line (517, 10)-(517, 358)
Form1.Line (517, 358)-(10, 358)
End Sub

Private Sub DibujarCara()
Picture1.FillStyle = vbSolid
Picture1.FillColor = vbYellow
Picture1.Circle (48, 48), 45
Picture1.FillColor = vbBlack
Picture1.Circle (30, 35), 10
Picture1.Circle (65, 35), 10
Picture1.Circle (47, 55), 8
Picture1.DrawWidth = 2
Picture1.Circle (48, 50), 30, , 3.4, 6, 1#
End Sub

El código completo de la Aplicación puede bajarse de Aquí.