Practicas Visual Basic 6.0

VISUAL BASIC CECYTEM TECAMAC

PRACTICA #1
En la siguiente práctica realizaremos un ejercicio sencillo, en cual analizares, la función de un Option
Button, con sus diferentes códigos, utilizando códigos de color y alineación:
Para comenzar deben crear un formulario como el que continuación se les muestra.

Utilizaremos los siguientes OBJETOS:
1 Textbox
2 Frame
6 Option Button

Ya colocados en nuestro formulario les daremos las siguientes propiedades:

OBJETO NAME CAPTION
Frame 1 fraColores Colores
Option 1 optAzul Azul
Option 2 optRojo Rojo
Option 3 optVerde Verde
Option 4 optAmarillo Amarillo
Frame 2 fraPosicion Posición
Option 4 optArriba Arriba
Option 4 optAbajo Abajo
Text 1 txtCaja Caja
Formulario frmColores Colores

Ahora colocaremos el siguiente código:
Private Sub optAbajo_Click()
Damos dos clic en el formulario aparecerá el txtCaja.Top = Form1.ScaleHeight -
nombre del botón o comando seleccionado: txtCaja.Height
End Sub
Private Sub Form_Load() Private Sub optAzul_Click()
End Sub txtCaja.BackColor = vbBlue
End Sub
Dentro de la misma opción colocamos la Private Sub optRojo_Click()
siguiente línea de código: txtCaja.BackColor = vbRed
End Sub
Private Sub Form_Load() Private Sub optVerde_Click()
txtCaja.Top = 0 txtCaja.BackColor = vbGreen
End Sub End Sub
Private Sub optAmarillo_Click()
Y dado clic en el respectivo botón colocamos txtCaja.BackColor = vbYellow
su código: End Sub
Después procedemos a guardar:
Option Explicit
Private Sub Form_Load() 1. Nos vamos al Menú Archivo >> Guardar
txtCaja.Top = 0 formulario/Aceptar y Guardar proyecto/Aceptar
End Sub NOTA: Es necesario guardar el formulario y el
Private Sub optArriba_Click() proyecto al mismo tiempo que guarda uno, ya
txtCaja.Top = 0 que si no lo haces, y después quieres abrir tu
End Sub archivo no se reproducirá.

P. Ing. René Domínguez Escalona


PRACTICA #2
Realizar una calculadora elemental que permite hacer las cuatro opciones aritméticas básicas, los ficheros de este
proyecto se pueden llamar Minicalculadora.vbp el usuario introduce los datos y clica sobre el botón
correspondiente a la operación que desea realizar, apareciendo inmediatamente el resultado en la caja de texto de
la derecha.

Este será el formulario que realizaremos:

A continuación se darán los siguientes valores para los OBJETOS que introduciremos en el formulario:

OBJETO NAME CAPTION o TEXT
Formulario frmMinacalc Minicalculadora
Text1 txtOper1
Label 1 lblOp
Text2 txtOper2
Label 2 lblEqual =
Text3 txtResult
Comand 1 cmdSuma +
Comand 2 cmdResta -
Comand 3 cmdProd *
Comand 4 cmdDiv /

Ahora proceda a ingresa el código de los botones:

Private Sub cmdDiv_Click()
txtResult.Text = Val(txtOper1.Text) / Val(txtOper2.Text)
lblOp.Caption = "/"
End Sub
Private Sub cmdProd_Click()
txtResult.Text = Val(txtOper1.Text) * Val(txtOper2.Text)
lblOp.Caption = "*"
End Sub
Private Sub cmdResta_Click()
txtResult.Text = Val(txtOper1.Text) - Val(txtOper2.Text)
lblOp.Caption = "-"
End Sub
Private Sub cmdSuma_Click()
txtResult.Text = Val(txtOper1.Text) + Val(txtOper2.Text)
lblOp.Caption = "+"
End Sub

Ahora procedemos a guardar nuestra práctica:

En esta práctica se ha utilizado repetidamente la función Val() de Visual Basic. Esta función convierte una serie
de caracteres (un texto formado por cifras). Sin llamada a la función Val() el operador + aplicado a cadenas de
caracteres las concatena, y como resultado por ejemplo, “3+4” daría “34”. No es lo mismo los caracteres “1” y
“2” formando la cadena o String “12” que el numero 12; la función Val() convierte cadenas de caracteres
numéricos con los que se pueden realizar operaciones aritméticas en los números correspondientes con los que
opera matemáticamente Visual Basic 6.0 transforma de modo automático números en cadenas de caracteres y
viceversa.



PRACTICA #3
Realizar programas sencillos que permite ver que la equivalencia entre las escalas de temperaturas en grados
Centígrados y Fahrenheit. Los ficheros de este proyecto se pueden llamar Temperat.vbp y desplazarse con
incrementos pequeños de 1C° y grandes de 10C°. Como es habitual, también puede cambiarse el valor arrastrando
el con el ratón del cursor de la barra. Los valores máximos y mínimos de la barra son 100C° y -100C°.A ambos
lados de la barra aparecen dos cuadros de texto (color de fondo blanco) donde aparecen los grados
correspondientes a la barra en ambas escalas. Encima aparecen dos rótulos (labels) que indican la escala de
temperaturas correspondientes. Completan la aplicación un botón salir que termina la ejecución y el menú File con
la única opción Exit que termina así mismo la ejecución del programa.

Estos son los valores de los OBJETOS:
CONTROL NAME CAPTION o TEXT
Formulario frmConversor Conversor de temperaturas
Label 1 lblCent Centígrados
Text 1 txtCent
Comand 1 cmdSalir Salir
Label 2 lblFahr Fahrenheit
Text 2 txtFahr

CONTROL NAME MIN MAX SMALL CHANGE LARGE CHANGE VALUE
VScroll 1 vsbTemp 100 -100 1 10 0
Este será el formulario que realizaremos:

El código correspondiente a esta práctica es el siguiente:

Private Sub cmbSalir_Click ( )
Beep
End
End Sub
Private Sub vsbTemp_Change ( )
txtCent.Text = vsbTemp.Value
txtFahr.Text = 32 + 1.8 * vsbTemp.Value
End Sub

Sobre esta práctica se puede comentar lo siguiente:

1. Se ha utilizado la propiedad Valué de la barra de desplazamiento, la cual da el valor actual de la misma con
respecto a los límites inferior y superior, previamente establecidos. (100 y 100).
2. Mediante el procedimiento cmbSalir_Click ( ); se cierra el programa gracias a la instrucción End. El cometido
del Beep no es otro que el de emitir un pitido atreves del altavoz del ordenador, que indicara que en efecto se ha
salido del programa.
3. Finalmente la función vsbTemp_Change ( ) se activa al cambiar el valor de la barra de desplazamiento; su
efecto es modificar el valor de la propiedad Text en las cajas de texto muestran la temperatura en cada una de las
dos escalas.



PRACTICA #4
En esta práctica se repiten procedimientos parecidos a los se vio en la primera práctica, en diferentes aplicaciones:
Estos son los valores de los OBJETO:
Formulario frmColores Colores
Frame 1 fraOpción
Label 1 lblRojo Rojo
Label 1 lblVerde Verde
Label 1 lblAzul Azul
Text 1 txtColor 0
Text 2 txtColor 0
Text 1 txtColor 0

Estos son los valores de los HScroll:
OBJETO NAME MIN MAX SMALL CHANGE LARGE CHANGE VALUE
HScroll 1,2,3 hsbColor 0 255 1 16 0

A continuación se muestra el código de la práctica:
Este es el formulario que realizaremos:
Public Brojo, Bverde, Bazul As Integer
Public Frojo, Fverde, Fazul As Integer
Private Sub cmdSalir_Click()
End
End Sub
Private Sub Form_Load()
Brojo = 0
Bverde = 0
Bazul = 0
Frojo = 255
Fverde = 255
Fazul = 255
lblCuadro.BackColor = RGB(Brojo, Bverde, Bazul)
lblCuadro.ForeColor = RGB(Frojo, Fverde, Fazul)
End Sub
Private Sub hsbColor_Change(Index As Integer)
If optColor(0).Value = True Then
lblCuadro.BackColor = RGB(hsbColor(0).Value, hsbColor(1).Value, hsbColor(2).Value)
Dim i As Integer
For i = 0 To 2
txtColor(i).Text = hsbColor(i).Value
Next i
Else
lblCuadro.ForeColor = RGB(hsbColor(0).Value, hsbColor(1).Value, hsbColor(2).Value)
For i = 0 To 2
txtColor(i).Text = hsbColor(i).Value
Next i
End If
End Sub
Private Sub optColor_Click(Index As Integer) Brojo = hsbColor(0).Value
If Index = 0 Then Bverde = hsbColor(1).Value
Frojo = hsbColor(0).Value Bazul = hsbColor(2).Value
Fverde = hsbColor(1).Value hsbColor(0).Value = Frojo
Fazul = hsbColor(2).Value hsbColor(1).Value = Fverde
hsbColor(0).Value = Brojo hsbColor(2).Value = Fazul
hsbColor(1).Value = Bverde End If
hsbColor(2).Value = Bazul End Sub
Else



PRACTICA #5
En la siguiente práctica realizaremos carga y descarga de formularios, este proceso se realiza en una serie de dos
pasos el primer evento y el segundo evento se deberán realizar dos formularios como los marcan las siguientes
imágenes:

(PRIMER EVENTO)

a) Carga y descarga de formularios: Cuando se arranca una aplicación, o más en concreto, cuando se visualiza por
primera vez un formulario, se producen varios eventos ejecutivos, Initializate, Load, Activate, Paint. Cada uno
de estos eventos se puede aprovechar para realizar ciertas operaciones correspondientes.

Este es su código Correspondiente: Segundo Formulario:
Primer Formulario:
Private Sub cmdHide_Click()
Private Sub cmdCargar_Click() Hide
frmSecundario.Show End Sub
End Sub Private Sub cmdUnload_Click()
Private Sub cmdSalir_Click() Unload Me
End End Sub
End Sub Private Sub cmdTerminate_Click()
Hide
Set frmSecundario = Nothing
End Sub

(SEGUNDO EVENTO)

Al ocultar, cerrar o eliminar un formulario se produce otra serie de eventos.
Desactivate, Query, Unload, Terminate.

Este es el código correspondiente a esta opción y se coloca después de probar el segundo
formulario, y se coloca en el segundo formulario:

Private Sub Form_Activate() Private Sub Form_Paint()
MsgBox ("Evento Activate") MsgBox ("Evento Paint")
End Sub End Sub
Private Sub Form_Deactivate() Private Sub Form_QueryUnload(Cancel As
MsgBox ("Evento Deactivate") Integer, UnloadMode As Integer)
End Sub MsgBox ("Evento QueryUnload")
Private Sub Form_Initialize() End Sub
MsgBox ("Evento Initialize") Private Sub Form_Terminate()
End Sub MsgBox ("Evento Terminate")
Private Sub Form_Load() End Sub
MsgBox ("Evento Load") Private Sub Form_Unload(Cancel As Integer)
End Sub MsgBox ("Evento Unload")
End Sub



PRACTICA #6
En esta práctica aprenderos a utilizar los comandos como son Limpiar y Borrar, con los mismos
procedimientos de las prácticas anteriores:

Formulario frmLista Lista
Label 1 lblIntroducir Introducir Datos
Text1 txtEntrada
Label 2 lblLista Lista de Datos
ListBox lstLista
Label 3 lblMedia Valor medio
Text2 txtMedia
Comand 1 cmdAgregar Agregar
Comand 2 cmdEliminarU Eliminar Ultimo
Comand 3 cmdEliminarT Eliminar Todo
Comand 5 cmdCalcular Calcular
Text3 txtDesv
Label 4 lblDesv Desviación típica
A continuación se muestra el código del formulario:

Private Sub cmdAgregar_Click() Este es nuestro formulario:
If IsNumeric(txtEntrada.Text) Then
lstLista.AddItem Val(txtEntrada.Text)
Else
MsgBox ("Un valor númerico, por favor!")
End If
txtEntrada.Text = ""
txtMedia.Text = ""
txtDesv.Text = ""
txtEntrada.SetFocus
End Sub
Private Sub cmdCalcular_Click()
Dim I As Integer
Dim media, desv As Double
media = 0#: desv = 0#
If lstLista.ListCount > 1 Then
For I = 0 To lstLista.ListCount - 1
media = media + lstLista.List(I)
Next I
media = media / lstLista.ListCount
For I = 0 To lstLista.ListCount - 1
desv = desv + (lstLista.List(I) - media) ^ 2
Next I
desv = desv / (lstLista.ListCount - 1)
Else
MsgBox ("Por favor, agregar un valor")
End If
txtMedia.Text = Format(media, "###0.00")
txtDesv.Text = Format(Sqr(desv), "###0.00")
txtEntrada.SetFocus
End Sub
Private Sub cmdEliminarT_Click()
lstLista.Clear
txtMedia.Text = ""
txtDesv.Text = ""
txtEntrada.SetFocus



End Sub
Private Sub cmdEliminarU_Click()
If lstLista.ListCount > 0 Then
lstLista.RemoveItem (lstLista.ListCount - 1)
End If
txtMedia.Text = ""
txtDesv.Text = ""
txtEntrada.SetFocus
End Sub
End
End Sub
lstLista.Clear
End Sub
Private Sub Form_Paint()
txtEntrada.SetFocus
End Sub
Private Sub txtEntrada_KeyPress(KeyAscii As Integer)
If (KeyAscii = 13) Then
lstLista.AddItem Val(txtEntrada.Text)
Else
MsgBox ("Un valor númerico, por favor!")
End If
txtMedia.Text = ""
txtDesv.Text = ""
txtEntrada.SetFocus
End If
End Sub
Después proceda a guarda su proyecto y su formulario:



PRACTICA #7
En esta práctica se muestra en el formulario diferentes comandos, el fin de esta práctica es aprender el
funcionamiento de cada uno de ellos e incorporando el uso de módulos, viendo cuál es su función. Primero
se crea el formulario y luego se agrega el modulo.
Este es nuestro formulario:

Private Sub cmdMinimo_Click()
Dim Nums(1 To 30) As Integer
Dim i As Integer
For i = 1 To lstNum.ListCount
lstNum.ListIndex = i - 1
Nums(i) = lstNum.List(lstNum.ListIndex)
Next i
txtMin.Text = Min(Nums, lstNum.ListCount)
lstNum.ListIndex = -1
txtEntrada.SetFocus
End Sub

Private Sub cmdEliminarU_Click()
lstNum.RemoveItem lstNum.ListCount - 1
txtEntrada.SetFocus
txtMax.Text = ""
txtMin.Text = ""
Este es su código:
txtSum.Text = ""
End Sub
Option Explicit
Private Sub cmdAgregar_Click()
Private Sub cmdOrdenar_Click()
lstNum.AddItem Val(txtEntrada.Text)
Dim i As Integer
Else
MsgBox ("A numeric value, please!")
End If
txtEntrada.SetFocus
Next i
Call Ordenar(Nums, lstNum.ListCount)
txtMax.Text = ""
txtMin.Text = ""
txtSum.Text = ""
lstNum.List(lstNum.ListIndex) = Nums(i)
End Sub
Next i
Private Sub cmdLimpiar_Click()
lstNum.Clear
txtEntrada.SetFocus
txtEntrada.SetFocus
End Sub
txtMax.Text = ""
txtMin.Text = ""
Private Sub cmdSuma_Click()
txtSum.Text = ""
Dim sum, i As Integer
End Sub
For i = 0 To lstNum.ListCount - 1
sum = sum + Val(lstNum.List(i))
End
Next i
End Sub
txtSum.Text = sum
Private Sub cmdMaximo_Click()
txtEntrada.SetFocus
End Sub
Dim i As Integer
Private Sub Form_Paint()
txtEntrada.SetFocus
End Sub
Next i
txtMax.Text = Max(Nums, lstNum.ListCount)
txtEntrada.SetFocus
End Sub



Private Sub txtEntrada_KeyPress(KeyAscii As Integer)
If (KeyAscii = 13) Then
lstNum.AddItem Val(txtEntrada.Text)
Else
MsgBox (“Solo Numeros, por favor!")
End If
txtMax.Text = ""
txtMin.Text = ""
txtSum.Text = ""
End If
End Sub

Ahora veremos como insertar un módulo:

Y este es su código:

Public Sub Ordenar(Numbers() As Integer, N As Integer)
Dim Temp As Integer
Dim i, j As Integer
For i = 1 To N - 1
For j = i + 1 To N
If Numbers(i) > Numbers(j) Then
Temp = Numbers(i)
Numbers(i) = Numbers(j)
Numbers(j) = Temp
End If
Next j
Next i
End Sub

Public Function Max(Numbers() As Integer, N As Integer) As Integer
Dim i As Integer
maximum = Numbers(1)
For i = 2 To N
If Numbers(i) > maximum Then
maximum = Numbers(i)
End If
Next i
End Function

Public Function Min(Numbers() As Integer, N As Integer) As Integer
Dim i As Integer
minimum = Numbers(1)
For i = 2 To N
If Numbers(i) < minimum Then
minimum = Numbers(i)
End If
Next i
End Function



PRACTICA #8
Para poder realizar esta práctica, primero deberá crear un formulario principal, y luego crear de uno por uno
los demás, aquí aplicaremos varios comandos ya utilizados anteriormente.
ESTE ES EL FORMULARIO PRINCIPAL:

Estas son las propiedades del formulario principal:

OBJETO NAME CAPTION
Formulario frmMain Ejemplos de controles
Menú File mnuFile File
Menú File Options mnuFileOp Options
Comandd1 cmdButtons &Semáforo
Comandd2 cmdWordWrap &Etiquetas
Comandd3 cmdCheck &Botones de Selecció
Comandd4 cmdOption Botones de O&pción
Comandd5 cmdExit E&xit
Ahora agregamos un nuevo formulario:

SEGUNDO FORMULARIO:
Este será el nuevo formulario:(Para realizar
este formulario deberá insertar algunas
imágenes de semáforo y son tres).

Estas son sus propiedades:

OBJETO NAME CAPTION O PICTURE
Formulario frmButton Semáforo
ImgRed imgRed Icono
ImgVerde imgVerde Icono
ImgAmarillo imgAmarillo Icono
Comandd1 cmdChange Cambiar lu&z
Comandd2 cmdClose &Cerrar
El formulario siguiente es el que a continuación se muestra TERCER FORMULARIO:



Estas son sus propiedades:

CONTROL NAME CAPTION
Formulario frmWordWrap WordWrap and Autosize
Label1 lblDisplay Ejemplo de uso de las
propiedades AutoSize y
WordWrap en las Labels.
Frame1 Frame1 Alineación:
Option 1 optIzda Izquierda
Option 2 optDcha Derecha
Option 3 optCentro Centrado
Frame2 Frame2
Check1 chkAutoSize &AutoSize
Check2 chkWordWrap &WordWrap
Comandd1 cmdClose &Cerrar

Este es el CUARTO FORMULARIO:

Este es el QUINTO FORMULARIO:

Ya terminados todos nuestros formularios procedamos a ingresar el código:

PRIMER FORMULARIO:
Private Sub mnuFileExit_Click()
Private Sub cmdBotones_Click() cmdSalir_Click
mnuSemaforo_Clic End Sub
End Sub Private Sub mnuOption_Click()
Private Sub cmdCajaVerificacion_Click() frmOptiones.Show
mnuCheck_Click End Sub
End Sub Private Sub mnuLabel_Click()
Private Sub cmdSalir_Click() frmWordWrap.Show
Unload Me End Sub
End
End Sub SEGUNDO FORMULARIO:
Private Sub cmdBotonesOpcion_Click()
mnuOption_Click Private Sub CambiarLuz()
End Sub If imgGreen.Visible = True Then
Private Sub cmdWordWrap_Click() imgGreen.Visible = False
mnuLabel_Click imgYellow.Visible = True
End Sub ElseIf imgYellow.Visible = True Then
Private Sub Form_Load() imgYellow.Visible = False
frmMain.Height = 3600 imgRed.Visible = True
frmMain.Width = 4965 Else
End Sub imgRed.Visible = False
Private Sub mnuSemaforo_Click() imgGreen.Visible = True
frmBotones.Show End If
End Sub End Sub
Private Sub mnuCheck_Click() Private Sub cmdCambiarLuz_Click()
frmCajasVerificacion.Show Call CambiarLuz
End Sub End Sub



Unload Me CUARTO FORMULARIO:
End Sub
Private Sub Form_Load() Private Sub chkNegritas_Click()
imgGreen.Visible = True txtDisplay.FontBold = Not txtDisplay.FontBold
imgYellow.Visible = False End Sub
imgRed.Visible = False Private Sub chkItalica_Click()
End Sub txtDisplay.FontItalic = Not txtDisplay.FontItalic
Private Sub imgGreen_Click() End Sub
Call CambiarLuz Private Sub cmdSalir_Click()
End Sub Unload Me
Private Sub imgRed_Click() End Sub
Call CambiarLuz
End Sub
Private Sub imgYellow_Click()
Call CambiarLuz QUINTO FORMULARIO:
End Sub
Dim tipoPC As String
TERCER FORMULARIO: Dim tipoSO As String

Private Sub chkAutoSize_Click() Sub Escribir()
lblDisplay.Left = 480 lblDisplay.Caption = "Ha seleccionado un " & _
lblDisplay.Width = 1730 tipoPC & " con " & tipoSO
lblDisplay.Height = 225 End Sub
lblDisplay.AutoSize = Not lblDisplay.AutoSize Private Sub cmdSalir_Click()
End Sub Unload Me
Private Sub chkWordWrap_Click() End Sub
lblDisplay.Left = 480 Private Sub Form_Load()
lblDisplay.Width = 1730 optAMD_Click
lblDisplay.Height = 225 optWin95_Click
lblDisplay.WordWrap = Not lblDisplay.WordWrap End Sub
End Sub Private Sub opt686_Click()
Private Sub cmdSalir_Click() tipoPC = "Pentium II/III"
Unload Me Call Escribir
End Sub End Sub
Private Sub Form_Load() Private Sub optAMD_Click()
lblDisplay.Left = 480 tipoPC = "AMD"
lblDisplay.Top = 480 Call Escribir
lblDisplay.Width = 1730 End Sub
lblDisplay.Height = 225 Private Sub opt586_Click()
lblDisplay.AutoSize = False tipoPC = "Pentium"
lblDisplay.WordWrap = False Call Escribir
lblDisplay.Alignment = 0 End Sub
End Sub Private Sub optWin95_Click()
Private Sub optCentro_Click() tipoSO = "Windows 95/98"
lblDisplay.Alignment = 2 Call Escribir
End Sub End Sub
Private Sub optDerecha_Click() Private Sub optWinNT_Click()
lblDisplay.Alignment = 1 tipoSO = "Windows NT"
End Sub Call Escribir
Private Sub optIzquierda_Click() End Sub
lblDisplay.Alignment = 0
End Sub

NOTA:
Para guardar este proyecto deberá guardar los formularios de uno por uno y al final el proyecto.



PRACTICA #9
En esta práctica se utiliza varios comandos diseñados especialmente para las barras de desplazamiento, y
utilizaremos los Picture Box o (Cajas de dibujo), Aprenderás a formar figuras mediante un código:

Este es su código:
Option Explicit
Dim vx, vy, t, altura, anchura, xpos As Double
Private Sub cmdDispara_Click()
vx = Val(txtV.Text) * Cos(Val(txtAngulo.Text) * 3.141592 / 180#)
vy = Val(txtV.Text) * Sin(Val(txtAngulo.Text) * 3.141592 / 180#)
Timer1.Interval = 50
Timer1.Enabled = True
t=0 Este será nuestro formulario:
End Sub
End
End Sub
pctBox.Scale (0, 100)-(200, 0)
t=0
txtV.Text = 35
txtAngulo.Text = 50
pctBox.Circle (190, 10), 10, vbRed
pctBox.Line (100, 0)-(120, 50), vbRed, BF
altura = 50
vsbAltura.Value = 100 - altura
anchura = 20
hsbAnchura.Value = anchura
xpos = 100
hsbXpos.Value = xpos
End Sub
Private Sub hsbXpos_Change()
xpos = hsbXpos.Value
pctBox.Cls
pctBox.Line (xpos, 0)-(xpos + anchura, altura), vbRed, BF
End Sub
Private Sub Timer_Timer()
Dim x, y As Double
Dim distancia As Double
pctBox.Cls
t = t + 0.1
x = vx * t
y = vy * t - 9.81 / 2# * t * t
pctBox.DrawWidth = 3
pctBox.PSet (x, y), vbRed
pctBox.DrawWidth = 1
If x > xpos Then
If y > 0 Then
If x < xpos + anchura Then
If y < altura Then
MsgBox ("Ha tocado el bloque")
Timer1.Enabled = False
End If
End If
End If



End If
distancia = Sqr((x - 190) ^ 2 + (y - 10) ^ 2)
If distancia < 10 Then
Beep
MsgBox ("Ganaste")
Timer1.Enabled = False
End If
End Sub
Private Sub vsbAltura_Change()
altura = 100 - vsbAltura.Value
pctBox.Cls
End Sub
Private Sub hsbAnchura_Change()
anchura = hsbAnchura.Value
pctBox.Cls
End Sub

*Ahora guardamos nuestra aplicación*



PRACTICA #10
Esta práctica tiene varios formularios como la practica 8, pero en esta aplicación veremos como introducir
imágenes, que no son de utilidad para crear mejores bases de datos e incluso agendas electrónicas:

Este será el primer formulario:
Este es su código:
Option Explicit
Dim Por(1 To 3) As String
Dim Def(1 To 12) As String
Dim Med(1 To 12) As String
Dim Del(1 To 12) As String
Dim nPor As Integer, nTotalPor As Integer
Dim nDef As Integer, nTotalDef As Integer
Dim nMed As Integer, nTotalMed As Integer
Dim nDel As Integer, nTotalDel As Integer
Function BuscarAlin(jug As String) As Boolean
BuscarAlin = False
Dim i As Integer
For i = 0 To lstAlin.ListCount - 1
If jug = lstAlin.List(i) Then BuscarAlin = True
Next i
End Function
Sub AddJugadores(Juga() As String, n As Integer)
Dim i As Integer
For i = 1 To n
lstJuga.AddItem (Juga(i))
Next
End Sub
Function id(jugador As String) As String Este será el segundo formulario:
Dim i As Integer
For i = 1 To nTotalPor
If StrComp(jugador, Por(i)) = 0 Then
id = "Portero"
Exit Function
End If
Next i
For i = 1 To nTotalDef
If StrComp(jugador, Def(i)) = 0 Then
id = "Defensa"
Exit Function
End If
Next i
For i = 1 To nTotalMed Este será el tercer formulario:
If StrComp(jugador, Med(i)) = 0 Then
id = "Medio"
Exit Function
End If
Next i
For i = 1 To nTotalDel
If StrComp(jugador, Del(i)) = 0 Then
id = "Delantero"
Exit Function
End If
Next i
End Function
Sub Imprimir()
lblPor.Caption = nPor
lblDef.Caption = nDef



lblMed.Caption = nMed
lblDel.Caption = nDel
Dim nJug As Integer
nJug = nPor + nDef + nMed + nDel
If nJug > 11 Then
nJug = MsgBox("¿Desea alinear más de 11 jugadores?" + vbCrLf + _
"Recuerde que tendrá que convencer al árbitro y al otro equipo")
End If
End Sub
Sub AnadirSiNoEstaYa(jug As String) Def(2) = "Dehu"
Dim puesto As String Def(3) = "Sergi"
If BuscarAlin(jug) = False Then Def(4) = "Ronald de Boer"
lstAlin.AddItem (jug) Def(5) = "Reiziger"
puesto = id(jug) Def(6) = "Bogarde"
If puesto = "Portero" Then nPor = nPor + 1 Def(7) = "Puyol"
If puesto = "Defensa" Then nDef = nDef + 1 Def(8) = "Frank de Boer"
If puesto = "Medio" Then nMed = nMed + 1 nTotalDef = 8
If puesto = "Delantero" Then nDel = nDel + 1 Med(1) = "Litmanen"
End If Med(2) = "Guardiola"
End Sub Med(3) = "Xavi"
Private Sub cmdAuto_Click() Med(4) = "Gabri"
vanGaal.Show Med(5) = "Cocu"
End Sub Med(6) = "Mario"
Private Sub cmdClear_Click() nTotalMed = 6
lstAlin.Clear Del(1) = "Figo"
nPor = 0 Del(2) = "Rivaldo"
nDef = 0 Del(3) = "Luis Enrique"
nMed = 0 Del(4) = "Dani"
nDel = 0 Del(5) = "Kluiwer"
Call Imprimir Del(6) = "Zenden"
End Sub Del(7) = "Simao"
Private Sub cmdJugadores_Click() Del(8) = "Nano"
frmBarsa.Show Del(9) = "Amunike"
End Sub nTotalDel = 9
Private Sub cmdSalir_Click() nPor = 0
End nDef = 0
End Sub nMed = 0
Private Sub Form_Load() nDel = 0
Por(1) = "Hesp" Call AddJugadores(Por, 3)
Por(2) = "Andreu" Call Imprimir
nTotalPor = 2 End Sub
Def(1) = "Abelardo"

Private Sub lblDef_Change()
Dim resp As Integer
If nDef > 5 Then
resp = MsgBox("¿Desea jugar con más de 5 defensas?", vbOKOnly)
End If
End Sub
Private Sub lblPor_Change()
Dim resp As Integer
If nPor > 1 Then
resp = MsgBox("¿Desea jugar con más de un portero?" _
+ vbCrLf + "Recuerde que sólo uno podrá tocar el balón con la mano", vbOKOnly)
End If
End Sub



Private Sub lstAlin_Click() Private Sub optDef_Click()
Dim jug As String, puesto As String lstJuga.Clear
jug = lstAlin.List(lstAlin.ListIndex) Call AddJugadores(Def, nTotalDef)
lstAlin.RemoveItem (lstAlin.ListIndex) End Sub
puesto = id(jug) Private Sub optDel_Click()
If puesto = "Portero" Then nPor = nPor - 1
If puesto = "Defensa" Then nDef = nDef - 1 lstJuga.Clear
If puesto = "Medio" Then nMed = nMed - 1 Call AddJugadores(Del, nTotalDel)
If puesto = "Delantero" Then nDel = nDel – 1 End Sub
Private Sub optMed_Click()
Call Imprimir lstJuga.Clear
End Sub Call AddJugadores(Med, nTotalMed)
Private Sub lstJuga_Click() End Sub
Dim jug As String Private Sub optPor_Click()
jug = lstJuga.List(lstJuga.ListIndex) lstJuga.Clear
Call AnadirSiNoEstaYa(jug) Call AddJugadores(Por, nTotalPor)
Call Imprimir End Sub
End Sub

Ahora guardamos los cambios realizados en nuestra aplicación y hasta aquí terminan nuestro primer bloque de
prácticas.


Practicas Visual Basic 6.0

Más contenido relacionado

La actualidad más candente (20)

Destacado (20)

Similar a Practicas Visual Basic 6.0 (20)

Más de CECYTEM (20)

Último (20)

Practicas Visual Basic 6.0