Ejemplos de Codigos Muy Bueno
Ejemplos de Codigos Muy Bueno
Ejemplos de Codigos Muy Bueno
Crucigrama
Productos:Arrastrar y Soltar
Sumas Aleatorias
Control Animation
Sucesin de Imgenes
Objeto Printer
Barra de Herramientas
Animacin Transparente
Este ejercicio muestra un truco muy sencillo pero de gran utilidad. A veces
tenemos una imagen total que queremos particionar, en este caso la
computadora, que nos permite subdividirla en tres partes : monitor, teclado,
gabinete. Esto por cdigo sera muy complejo pero usando el control Label en su
modo transparente y con el Caption vaco, o sea sin etiqueta nos permite
subdividir la imagen y que sus partes respondan a el evento Click por separado,
provocando una respuesta distinta.
En el formulario podemos ver la Label dibujada sobre el monitor, todava opaca
como viene por defecto, luego sobre el gabinete est transparente pero con el
Caption , tambin por defecto en este caso : Label2. Y en el teclado donde est
posicionado el cursor en cambio est transparente. De acuerdo a la parte que
seleccionemos: en una cuarta Label se nos mostrar el texto correspondiente, en
el caso del formulario : "Teclado".
En este ejercicio tenemos una Image, con su Propiedad Stretch a True, lo que
nos permite agrandar un icono al tamao deseado. Y cuatro Labels, tres
transparentes para subdividir la Image y una opaca para mostrar la parte
seleccionada, y un Botn de Salida.
El Cdigo de este ejercicio es el siguiente:
Private Sub Command1_Click()
End ' Cierre de la aplicacin
End Sub
Private Sub Label2_Click() 'El evento Click modifica el titulo de 'label1
Label1.caption = "Monitor"
End Sub
Private Sub Label3_Click()
Label1.caption = "Gabinete"
End Sub
Private Sub Label4_Click()
Label1.caption = "Teclado"
End Sub
Ejercicio N 2: Crucigrama.
Comenzamos un nuevo proyecto.
Con este ejercicio queremos
sugerir una ejemplo de
crucigrama que cada uno podr
adaptar a los contenidos
requeridos. Tambin a partir de
aqu podramos elaborar un
Ahorcado.
El crucigrama est armado con cuadros de texto o sea controles Text,
encerrados dentro de un control frame, este control tiene la nica finalidad de
agrupar y contener otros controles, ordenando la interactividad de una manera
visual. Otros dos controles Frame agrupan las opciones vertical y horizontal.
Conteniendo controles CheckBox que al ser seleccionados hacen la correccin
de las letras ingresadas en las cajas de texto. El ingreso de las mismas se hace
en tiempo de ejecucin a travs del teclado.
A la derecha vemos unos controles Picture vacos que se cargaran con imgenes
que muestren por ejemplo una cara sonriente si la palabra es correcta o seria si
no lo es, o cualquier otro tipo de imagen .Podemos llamar a esta imagen con la
funcin LoadPicture desde cualquier parte de nuestro disco rgido. Y un botn
con el icono de Hijitus indica la Salida y cierre del programa.
Ac tendremos que crear por cdigo una estructura condicional que controle si la
entrada de datos es correcta o no.
El cdigo es el siguiente:
Private Sub Command1_Click()
End
End Sub
Private Sub Check1_Click()
If Text1.Text = "L" And Text2.Text = "O" And Text3.Text= "R" And Text4.Text ="O"
then ' este cdigo debe ir todo en un mismo regln y 'chequea si se escribi una
de las palabras correctas. Ciudado con los 'nombres de los Controles porque
seguramente Ustedes no tendrn la 'misma numeracin que yo. (Otra aclaracin
cuando usamos el carcter ' 'indicamos que todo lo que sigue es un comentario,
por lo tanto la 'computadora no lo ejecuta lo saltea, no es cdigo).
Image1. Picture = LoadPicture(c:\vb\Icons\Misc\Face03.ico) 'carita linda
Else 'Sino
Image1. Picture = LoadPicture(c:\vb\Icons\Misc\Face01.ico) 'carita fea
End Sub
Private Sub Check2_Click()
If Text2.Text = "O" And Text5.Text ="R" And Text9.Text ="O" then
Image2.Picture = LoadPicture(c:\vb\Icons\Misc\Face03.ico) 'carita linda
Else 'Sino
Image2. Picture = LoadPicture(c:\vb\Icons\Misc\Face01.ico) 'carita fea
End Sub
Private Sub Check3_Click()
If Text7.Text = "R" And Text8.Text ="A" And Text9.Text ="T" And Text4.Text ="O"
And Text10.Text ="N" then
Image3. Picture = LoadPicture(c:\vb\Icons\Misc\Face03.ico) 'carita linda Else 'Sino
Image3. Picture = LoadPicture(c:\vb\Icons\Misc\Face01.ico) 'carita fea
End Sub
Aqu tambin usamos el Mtodo Move para desplazar la imagen del Oso.
El cdigo de cada procedimiento es el siguiente:
Option Explicit
Dim A As Integer 'declaramos a como variable entera
Private Sub Form_Load()
A = 9 ' Inicializamos la variable en 9.
End Sub
Private Sub Timer_Timer()
A=A-1
If A = 0 then A = 8 'Al llegar al frame 0 vuelve a empezar
Picture1.Picture = PictureClip1.GraphicCell(A)
Picture1.Move Picture1.Left + 50, Picture1.Top + 50 'Mueve en diagonal
End Sub
Comenzamos con una variable = 9 porque los frames del osito deben disminuir y
no aumentar sino d la impresin de caminar al revs.
Una propiedad fundamental del PictureClip es la GraphicCell ya que ella
automatiza la divisin de la grilla(imagen total) en partes(frames).
En este caso en el Move usamos los dos argumentos el Left y el Top de la imagen
, propiedades que indican la ubicacin de sta en relacin al borde izquierdo
(coordenada x) y al borde superior (coordenada y). Lo que permitir que el oso se
mueva en diagonal.
En la explicacin slo est detallado el movimiento del oso, en el formulario
vemos agregadas otros controles Line e Image simulando una calle, un semforo
y una seal de Stop, como para darles una idea de lo que podran agregar a la
escena.
Ejercicio N 4: Sumas.
La funcin Rnd nos permite cargar en una variable un nmero aleatorio que en
este caso definimos como entero Int (de Integer) y de 0 a 10.
Num1 = int( Rnd * 10)
Repetimos el procedimiento para Num2, el segundo sumando de nuestra cuenta.
Para que realmente sea aleatorio debemos incorporar la sentencia Randomize en
el Procedimiento Load del Formulario.
Otra funcin que utilizamos es Val que transforma una cadena de caracteres, en
este caso el contenido de un Text en un valor numrico.
Resultado = Val ( Text1.Text)
Y luego con un condicional y el operador de suma + controlamos si el resultado
es correcto:
If resultado = Int(num1) + Int(num2) then...
En el caso de resolver bien la cuenta pasa a cargar otros dos nmeros , iniciando
una nueva cuenta. Pero necesitamos una espera en la aplicacin. Esto lo
hacemos por cdigo con un bucle que asociado al reloj del sistema crea una
pausa en la aplicacin. Para esto creamos un Procedimiento llamado Pausa.
Posicionados en la ventana de cdigo , vamos a Tools/ Herramientas, Add
Procedure/ Agregar Procedimiento, y en la ventana que se nos abre elegimos un
Name para el mismo en este caso = Pausa y luego con los botones de opcin
seleccionamos: Sub y Private. Damos el Aceptar y se cierra la ventana. Ahora
veremos en nuestra ventana de cdigo un nuevo Procedimiento llamado Pausa.
Incluido dentro de los procedimientos del objeto General. Luego lo llamaremos
Else
Image1.Picture = Picture2.Picture
End If
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Form_Load()
Randomize
num1 = Int(Rnd * 10)'al cargarse el programa ya aparece una cuenta
num2 = Int(Rnd * 10)
Text1.Text = ""
Label1.Caption = num1'se vuelcan las variables en las Labels
Label2.Caption = num2
Command2.Enabled = False'el botn aplicar est desactivado
End Sub
Private Sub Text1_Change()
Command2.Enabled = True'al cambiar el texto se activa Aplicar
End Sub
Ejercicio N 5: Torero.
La sucesin de imgenes la
realiza un control Timer asociado
a un contador , cada imagen se
relaciona con un texto que
desplegamos en una Label
colocada debajo de la imagen
central. Al llegar el contador a 12
se detiene la sucesin y se
muestra una Label con los
nombres de los creadores de la
aplicacin.
La Label = Reiniciar nos posibilita volver a comenzar sin salir de la aplicacin,
para esto inicializa la variable A = 0 y pone el Timer nuevamente en
funcionamiento.
El cdigo de los principales procedimientos es el siguiente:
Option explicit
Dim A as Integer
Private Sub Label3_Click() ' esta es la label de reiniciar
Timer1.enabled = True
A=0
Label2.caption = "Lo primero es la coleta..."
Label4.visible = False ' oculta a los Autores
End Sub
Private Sub Timer1_Timer()
A=A+1
If A = 3 then
Image13.Picture= Image1.Picture
Label2.caption = "Y los tirantes despus..."
ElseIf A = 4 then
Image13.Picture = Image5.Picture
Label2.caption = "enseguida la corbata..."
Elseif A = 5 Then ' Y as las distintas opciones de Imgenes y de Texto.
Label4.Visible = True ' muestra los Autores
Timer1.enabled = False ' desactiva el Timer
End If
End Sub
Controlen el orden de las Imgenes de acuerdo a su propia aplicacin, y los
Ejercicio N 7: Cubos.
Ejercicio N 8: Da Feliz.
Text1.text = total
End Sub
Ac vemos la importancia del argumento Source como control de origen, porque
nos permite testear en el condicional a que imagen nos estamos refiriendo.
Tenemos 3 Labels que muestran los nmeros a ordenar y otras 3 Labels que
recibirn los nmeros drageados de las Labels anteriores. Y dos Botones El de
Nmeros que a travs del procedimiento Azar elige tres nmeros aleatorios para
cada label con la funcin Randomize y el Botn Corregir que chequea que estn
ordenados realmente de menor a mayor. La Label7 muestra un "Bien" o un "Mal",
de acuerdo a si el orden es correcto o no. El cdigo es el siguiente:
Dim N1, N2, N3 as Integer ' declaramos las variables en General.
Private Sub Command1_Click() ' Este es el botn Nmeros
Label4.caption = ""
Label5.caption = ""
Label6.caption = "" ' vaciamos los nmeros ordenados
Label1.visible = True
Label2.visible = True
Label3.visible = True ' volvemos visibles las Label que drageamos.
Call Azar ' Convocamos al procedimiento creado en General.
End Sub
Private Sub Azar() ' creamos un procedimiento llamado Azar
N1= int(Rnd * 10) + 1 ' elige un nmero aleatorio de 1 a 10
N2= int(Rnd * 10) +1
N3= int(Rnd * 10) +1
If N1 <> N2 And N2 <> N3 And N1 <> N3 then 'controla que no haya 2 nmeros
iguales. Usamos los operadores <> y And.
Label1.caption = N1 ' volcamos los valores de las variables en las labels.
Label2.caption = N2
Label3.caption = N3
Else
Exit Sub ' Si uno de los nmeros se repite sale de la Rutina y vuelve a llamarse al
procedimiento Azar desde el Botn 1.
End If
End Sub
Private Command2_Click () ' Este es el Botn Corregir.
If Val(Label4.Caption) < Val(Label5.Caption) And Val(Label5.Caption) <
Val(Label6.caption) Then ' Este condicional que controla el orden de los nmeros
debe ir en una sola lnea.
Label7.Caption = "Bien"
Else
Label7.caption= "Mal"
End If
End Sub
Private Sub Form_Load()
Randomize ' Reinicia la funcion Rnd
Call Azar ' llama al procedimiento Azar.
Private Sub Label4_DragDrop(..)
Label4.Caption = Source ' La label que recibe el control de Origen toma el caption
de este Origen.
Source.visible = False ' oculta el control de origen una vez drageado.
End Sub
Este cdigo de la Label4_DragDrop lo repetimos para la Label5 y la Label6 y
recordemos modificar su Dragmode a 1.
En tiempo de ejecucin luego de
arrastrar las Labels 1 2 y 3 sobre
las 4 5 y 6 y clickear en Corregir
veremos una pantalla similar a la
siguiente:
Y por cdigo le vamos a asociar un archivo Avi sin sonido porque sino no lo
carga , en este caso llamado FileCopy que se encuentra en el mismo directorio
del proyecto por eso usamos App.Path que quiere decir el camino o ruta de la
aplicacin.
Y con open abrimos, stop detenemos y play ejecutamos y close cerramos.
Private Sub Command1_Click()
Animation1.Close
Unload Me
End Sub
Volver a Ejercicios
Ms Ejercicios:
Internet: WebBrowser
Barra de Porcentaje
Navegador Simple
Control Tab
Dibujar: Coordenadas x, y
Control Anigif
Varios Formularios
Control Transicin
Animacin Transparente
Contrasea
Array de palabras
Editor de Men
Mtodo PaintPicture
Mtodo Print
Animacin de un Conejo
Ejecutar un .Avi
Mtodo Draw
Array de controles
Simulacin
Alarma: Timer
ScrollBar
Base de Datos previamente armada con el Data Jet, el motor para Base de Datos
de Visual Basic 5 o con Access, donde tendremos la informacin referente a cada
planeta, en este caso: el nombre del planeta, su distancia al sol en km. y la
cantidad de satlites (El proyecto final est incompleto, Uds. pueden completarlo
como les resulte ms conveniente).
El cdigo que nos vincula a la base de datos convocada por un control Data que
se encuentra invisible en el formulario de Informacin es el siguiente:
Private Sub Label12_Click() 'Esta label corresponde al planeta 'Jpiter
Label2.Caption = "Jpiter"
Form2.Data1.Recordset.MoveFirst 'mueve el puntero al comienzo
Form2.Data1.Recordset.Move 1 ' y luego un lugar al registro 'correspondiente en
la Base de datos Planetas
Form2.Picture1.Picture = Form2.ImageList1.ListImages(2).Picture
Form2.Show
End Sub
Para desplegar la imagen del planeta usamos un control ImageList que tiene
cargadas, en este caso solo dos imgenes: la Tierra y Jpiter.
La posicin del registro depende del orden que le dieron a los planetas en los
registros de la Base de datos.
Ustedes pueden agregar oros campos que desplieguen ms informacin y labels
indicativas de dichos campos.
Luego tenemos el Formulario evaluacin que a travs de la funcin InputBox le
hace al alumno dos preguntas: Una sobre el nombre del planeta y otra sobre la
cantidad de satlites que posee.
El formulario de evaluacin se
asemeja al siguiente:
Y el cdigo es:
Private Sub Picture1_Click() 'imagen de Jpiter
Sobre la palabra comida y animal tenemos superpuesta una label con la letra en
azul para que muestre la posible interactividad, tambin cambiamos el puntero
del mouse a una manito cuando pasa por sobre las palabras. Y al hacer click
cambia el contenido de la Image en su propiedad picture. El cdigo del evento
click de la primer label es:
Private Sub Label2_Click()
Image1.Picture = Picture2.Picture
Label4.Caption = "Una rica hamburguesa"
End Sub
Como vemos el cdigo es muy sencillo. El ejercicio completo lo pueden bajar de
Aqu.
Posicionados en la ventana
formulario activamos el Editor
mediante el cono
y cuando
se abre la ventana vamos
configurado los distintos item del
men como se ve en la siguiente
imagen:
Aqu hay dos propiedades muy importantes, el caption del men que ser el ttulo
que aparezca en el men y el name del men, el caption puede estar vaco pero el
name no, Y vamos anidando los submens que queremos incorporar, como lo
muestra la imagen, para desplegar un submen hacemos click en next y en la
flecha hacia la derecha para hacer una sangra que indica los subtemas del
men. Cada integrante del men responde a un solo evento que es el Click. Para
probarlo podemos agregar el siguiente cdigo en el evento click de cada men:
MnuFiambres_Click()
MsgBox "haz hecho click en la opcin bandeja de Fiambres"
End Sub.
Esto no est includo en el ejercicio, pero puede agregarle cualqier evento para
El cdigo es el siguiente:
Private Sub video()
MMControl1.DeviceType = "AVIVideo"
mueve aleatoriamente a una nueva posicin entre las medidas de ancho y alto del
formulario.
El cdigo del ejercicio pueden bajarlo de Aqu.
Text3.Text = baja
End Sub
Private Sub
Command3_Click() 'calcula la media de los contenidos de text1()
Dim total As Single
Dim promedio As Single
total = 0
For dia = 0 To 6
total = total + Text1(dia)
Next dia
promedio = total / 7
Text4.Text = Format(promedio, "##.##") 'formato con dos decimales
End Sub
Private Sub Command4_Click()
For dia = 0 To 6
Text1(dia).Text = ""
Next dia
Text1(0).SetFocus
End Sub
Private Sub Command5_Click()
End
End Sub
Usando estructuras de repeticin For Next, calculamos los valores de alta y baja,
luego para la media sacamos por divisin el promedio.
El cdigo completo del ejercicio podemos bajarlo de Aqu.
End Sub
Private Sub Form_Activate()' al cargarse el form y pasar a estar 'activo carga las
celdas o partes en que dividimos la imagen con 'el PictureClip.
Image1(0).Picture = PictureClip1.GraphicCell(3) Image1(1).Picture =
PictureClip1.GraphicCell(1) Image1(2).Picture = PictureClip1.GraphicCell(0)
Image1(3).Picture = PictureClip1.GraphicCell(5) Image1(4).Picture =
PictureClip1.GraphicCell(4) Image1(5).Picture = PictureClip1.GraphicCell(2)
End Sub
Private Sub Picture1_DragDrop(Source As Control, X As Single, Y As Single)
Picture1.Picture = Source
End Sub
Private Sub Picture2_DragDrop(Source As Control, X As Single, Y As Single)
'carga las imagenes de origen al soltarlas
Picture2.Picture = Source
End Sub Private Sub Picture3_DragDrop(Source As Control, X As Single, Y As
Single)
Picture3.Picture = Source
End Sub
Private Sub
Picture4_DragDrop(Source As Control, X As Single, Y As Single)
Picture4.Picture = Source
End Sub
Private Sub Picture5_DragDrop(Source As Control, X As Single, Y As Single)
Picture5.Picture = Source
End Sub
Private Sub
Picture6_DragDrop(Source As Control, X As Single, Y As Single)
Picture6.Picture = Source
End Sub
El cdigo completo puede bajarse de Aqu.
comenzar = Timer
Do Until controlar >= comenzar + 0.2
controlar = Timer
DoEvents
Loop
End Sub
El cdigo completo puede bajarse de Aqu.
Esta aplicacin tiene adems del Tab control un Data control que conecta con la
base de datos que elijamos, y dentro del control tab tenemos controles Text y
Labels para desplegar la informacin, como ya hemos hecho en otros ejercicios
con Base de Datos. No hay cdigo escrito, ya que las conecciones a la tabla
estan hechas directamente a travs de la ventana Propiedades. Tener en cuenta
las propiedades: DataBasename, y los controles Text que desplieguen los
campos elejidos.
La Aplicacin puede bajarse de Aqu.
El cdigo es el siguiente:
Option Explicit
Public pc, i As Integer
Private Sub Command1_Click()
Do
DoEvents
TransFX1.Effect = i
TransFX1.Start
Set TransFX1.PicBuffer = LoadPicture(App.Path & "\" &_ CStr(pc) & ".jpg")
pc = pc + 1: If pc > 3 Then pc = 1 i = i + 1: If i = 13 Then i = 1 Loop
End Sub
Private Sub
Command2_Click()
End
End Sub
Private Sub Form_Load()
pc = 1
i=1
Set TransFX1.PicTarget = LoadPicture(App.Path & "\" &_ CStr(pc) & ".jpg")
Set TransFX1.PicBuffer = LoadPicture(App.Path & "\" &_ CStr(pc + 1) & ".jpg")
End Sub
Las propiedades principales son: PicTarget que es la primera imagen que carga y
PicBuffer las siguientes, como minimo debemos tener 2 imagenes , pero
podemos cargar varias ms. Y el mtodo Start que lo inicia, podramos usar un
timer pero en este caso es un bucle el que repite la operacin pasando entre los
15 efectos posibles que permite el control.
Por cualquier duda incluyo el archivo de Ayuda del creador del activeX. Los
archivos con el control pueden bajarse de Aqu.
Loop
End Sub
Private Sub Form_Load()
Randomize b = 0
End Sub
Private Sub Image6_Click(Index As Integer) Image6(Index).Visible = False
b = b + 10
If Image6(Index).Left >= 2600 Then
Image7.Visible = True
ret = sndPlaySound(App.Path & "\Frogs.wav", SND_ASYNC Or
SND_NODEFAULT)
ElseIf Image6(Index).Left <= 2600 Then
Image8.Visible = True
ret = sndPlaySound(App.Path & "\Frogs.wav", SND_ASYNC Or
SND_NODEFAULT)
End If
Call pausa
Image7.Visible = False
Image8.Visible = False
Label1.Caption = "Puntaje =" & b
Call ganar
Call perder
End Sub
Private Sub Label2_Click()
Unload Me
Me.Show
End Sub
Private Sub Timer1_Timer()
contar = contar + 1
If contar = 1 Then
Image1.Picture = Image3.Picture
Image2.Picture = Image3.Picture
ElseIf contar = 2 Then
Image1.Picture = Image4.Picture
Image2.Picture = Image4.Picture
ElseIf contar = 3 Then
Image1.Picture = Image3.Picture
Image2.Picture = Image3.Picture
ElseIf contar = 4 Then
Image1.Picture = Image5.Picture
Image2.Picture = Image5.Picture
contar = 0
End If
End Sub
Private Sub
Timer2_Timer()
Dim x As Integer, y As Integer
For a = 0 To 9
Image6(a).Move CInt(Rnd * (Width - Image6(a).Width)), CInt(Rnd * (Height - 1600))
Next a
End Sub
Private Sub ganar()
If b = 100 Then
Label1.Caption = "GANASTE!!"
ret = sndPlaySound(App.Path & "\Fanfare.wav", SND_ASYNC Or
SND_NODEFAULT)
End If
End Sub
Private Sub perder()
If tiempo = 60 Then
Timer1.Enabled = False
Timer2.Enabled = False
Timer3.Enabled = False
Label1.Caption = "Perdiste!!"
ret = sndPlaySound(App.Path & "\desapa.wav", SND_ASYNC Or
SND_NODEFAULT)
End If
End Sub
Private Sub
Timer3_Timer() tiempo = tiempo + 1
Call perder
End Sub
Como vemos creamos tres procedimientos personalizados, ganar, perder y
pausa. El ejercicio completo puede bajarse de Aqu.
Option Explicit
Const SRCAND = &H8800C6
Const SRCINVERT = &H660046
Private Sub Form_Load()
PictureClip1.Rows = 3
PictureClip1.Cols = 3
PictureClip2.Rows = 3
PictureClip2.Cols = 3
End Sub
Private Sub Timer1_Timer()
Form1.Refresh
Dim x As Single, y As Single
End Sub
El ejercicio completo puede bajarse de Aqu.
Top = Top - 1
'Print numero(I)
Next I
End Sub
Private Sub Command1_Click()
If I > 1 Then
Label1.Caption = numero(I - 1)
Call mostrar
I=I-1
Else
Call azar
End If
End Sub
Private Sub
Command3_Click()
End
End Sub
Private Sub Command4_Click()
Text1.Text = ""
Text1.SetFocus
End Sub
Private Sub
Form_Activate()
Text1.SetFocus
End Sub
Private Sub
Form_Load()
Randomize
Call azar
Call Command1_Click
End Sub
Private Sub mostrar()
Select Case Label1
Case 1
Command2.Picture = Image1(0).Picture
Case 2
Command2.Picture = Image1(1).Picture
Case 3
Command2.Picture = Image1(2).Picture
Case 4
Command2.Picture = Image1(3).Picture
Case 5
Command2.Picture = Image1(4).Picture
Case 6
Command2.Picture = Image1(5).Picture
Case 7
Command2.Picture = Image1(6).Picture
Case 8
Command2.Picture = Image1(7).Picture
Case 9
Command2.Picture = Image1(8).Picture
Case 10
Command2.Picture = Image1(9).Picture
Case 11
Command2.Picture = Image1(10).Picture
Case 12
Command2.Picture = Image1(11).Picture
Case 13
Command2.Picture = Image1(12).Picture
Case 14
Command2.Picture = Image1(13).Picture
Case 15
Command2.Picture = Image1(14).Picture
Case 16
Command2.Picture = Image1(15).Picture
Case 17
Command2.Picture = Image1(16).Picture
Case 18
Command2.Picture = Image1(17).Picture
Case 19
Command2.Picture = Image1(18).Picture
Case 20
Command2.Picture = Image1(19).Picture
End Select
End Sub
Private Sub
Text1_Change()
Call corregir
End Sub
Private Sub corregir()
Static puntos As Integer
Select Case Label1
Case 1
If UCase(Text1.Text) = "CARAMBOLA" Then
puntos = puntos + 1
Case 2
If UCase(Text1.Text) = "APRESADO" Then
puntos = puntos + 1
Case 3
If UCase(Text1.Text) = "APRENDER" Then
puntos = puntos + 1
Case 4
If UCase(Text1.Text) = "CAJN" Then
puntos = puntos + 1
Case 5
If UCase(Text1.Text) = "CAMPAA" Then
puntos = puntos + 1
Case 6
If UCase(Text1.Text) = "CANOSO" Then
puntos = puntos + 1
Case 7
If UCase(Text1.Text) = "CARAC" Then
puntos = puntos + 1
Case 8
If UCase(Text1.Text) = "CASINO" Then
puntos = puntos + 1
Case 9
If UCase(Text1.Text) = "CORAZONADA" Then
puntos = puntos + 1
Case 10
If UCase(Text1.Text) = "CUCHARITA" Then
puntos = puntos + 1
Case 11
If UCase(Text1.Text) = "DEMONIO" Then
puntos = puntos + 1
Case 12
If UCase(Text1.Text) = "DEPORTE" Then
puntos = puntos + 1
Case 13
If UCase(Text1.Text) = "DIARIO" Then
puntos = puntos + 1
Case 14
If UCase(Text1.Text) = "DUENDE" Then
puntos = puntos + 1
Case 15
If UCase(Text1.Text) = "AUSTRALIA" Then
puntos = puntos + 1
Case 16
If UCase(Text1.Text) = "FLORENCIA" Then
puntos = puntos + 1
Case 17
If UCase(Text1.Text) = "INGENIO" Then
puntos = puntos + 1
Case 18
If UCase(Text1.Text) = "REINO" Then
puntos = puntos + 1
Case 19
If UCase(Text1.Text) = "VATICANO" Then
puntos = puntos + 1
Case 20
If UCase(Text1.Text) = "SOLDADO" Then
puntos = puntos + 1
End Select
Label2.Caption = "PUNTOS: " & puntos If puntos >= 20 Then
Label2.Caption = "Ganaste!"
End If
End Sub
El ejercicio completo puede bajarse de Aqu.
Option Explicit
Private Sub HScroll1_Change()
Label3.Caption =
Format$(HScroll1.Value)
Label4.Caption =
Chr$(HScroll1.Value)
End Sub
El ejercicio completo puede bajarse de Aqu.
List1.AddItem "fracaso"
List1.AddItem "nunca"
List1.AddItem "infeliz"
'Text1.Text = List1.List(3)
End Sub Private
Sub frasedoctor()
frase = Int(Rnd * 8)
Select Case frase
Case 0
Label1.Caption = "Cmo est Ud.?"
Case 1
Label1.Caption = "Cul es su estado de nimo?"
Case 2
Label1.Caption = "Tuvo Ud. una infancia feliz?"
Case 3
Label1.Caption = "Es feliz con el medio que lo rodea?"
Case 4
Label1.Caption = "Tiene problemas para relacionarse?"
Case 5
Label1.Caption = "Odia Ud. a su padre?"
Case 6
Label1.Caption = "Cree que no lo comprenden?"
Case 7
Label1.Caption = "Yo no estoy seguro de entenderlo"
End Select
End Sub
Private Sub respuestadoctor()
palabra = 0
If palabra >= 0 Then
For a = 0 To 24
Case "quiero"
Label1.Caption = "Por qu quiere usted eso?"
Case "deprimido"
Label1.Caption = "Qu lo deprime?"
Case "sin"
Label1.Caption = "Entiendo. Cree que lo puede remediar?"
Case "por que"
Label1.Caption = "Recuerde, la terapia es buena para Ud."
Case "dificil"
Label1.Caption = "No se preocupe, ya cambiarn las cosas."
Case "esperar"
Label1.Caption = "Tenga algo de paciencia."
Case "necesito"
Label1.Caption = "Todos necesitamos cosas."
Case "se"
Label1.Caption = "Como sabe Ud. eso?"
Case "odio"
Label1.Caption = "El odio nunca conduce a nada bueno"
Case "amor"
Label1.Caption = "Es importante amar"
Case "asesino"
Label1.Caption = "No me gusta la gente que mata"
Case "matar"
Label1.Caption = "No esta bien matar"
Case "grosero"
Label1.Caption = "No esta bien que me hable as!"
Case "no puedo"
Label1.Caption = "No sea negativo, sea positivo"
Case "fracaso"
Label1.Caption = " Debe luchar por el exito"
Case "nunca"
Label1.Caption = "No sea negativo, sea positivo"
Case "infeliz"
Label1.Caption = "Por que es infeliz?"
Case "adios"
Label1.Caption = "Le enviar la factura. Gracias."
RichTextBox1.Locked = True
Beep
Call pausa
End Case
Else
Call frasedoctor
End Select
End Sub
El cdigo completo puede bajarse de AQU.
Como vemos usamos la funcin randomize para ubicar los puntos en forma
aleatoria en el formulario y un bucle For/Next que dibuja 20 puntos por cada click
que hacemos en el botn: Puntos, el otro botn borra con Cls lo dibujo o sea
limpia el form. El mtodo Pset (Point Set) dibuja los puntos combinada con
QBColor que le asigna un color. El formato de los puntos es Dot.
El ejercicio completo pueden bajarlo de AQU.
Volver a Ejercicios.
ltimos Ejercicios:
Promediando Notas
Sumar Matrices
Array de Controles
Impresin Multilnea
Funcin Mid
TreeView
Movimiento
Efectos Visuales
Mtodo Line
Manejo de Errores
Msica
Video
Clculo de inters
Arreglos
Texto3D
Carita
Option Explicit
Dim Nota() As Single
Dim N As Integer 'Nmero total de notas.
End Sub
Private Sub Text1_LostFocus()
If IsNumeric(Text1.Text) Then 'Chequea si el valor es numrico.
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 numrico 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.
End If
End Sub
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
End
End Sub
El ejercicio completo puede bajarse de AQU.
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 nmero 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 nmero 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 nmeros del 0 al 9
If KeyAscii <> 8 Then KeyAscii = 0 'Para aceptar la tecla de retroceso
End If
End Sub
El cdigo completo puede bajarse de AQU.
End Sub
El cdigo completo puede bajarse de AQU.
En esta aplicacin se
crean con el mtodo Line
por clculo matemtico,
las rectas de un recorrido
y un cono cargado en un
control Image se
desplaza, siguiendo el
recorrido de las rectas. El
cdigo es:
Option Explicit
Dim x, y, x1, x2, y1, y2, l, t, w, h, m, delta As Single
Dim I As Byte
Sub Mover()
For I = 1 To 4 'Lazo para las 4 rectas.
'Asigna las coordenas para cada una de las 4 rectas.Las Rectas son un arreglo.
x1 = Linea(I).x1
y1 = Linea(I).y1
x2 = Linea(I).x2
y2 = Linea(I).y2
x = x1 'Inicializando la x.
Do Until x >= x2
m = (y1 - y2) / (x1 - x2) 'pendiente de la recta.
y = y1 + m * (x - x1) 'Ecuacin de la recta.
l = x - w / 2 'Valor que toma image1.left
t = y - h / 2 'Valor que toma image1.top
Image1.Left = l 'Pasar los valores anteriores
Image1.Top = t 'para mover la imagen.
x = x + delta 'Incrementando la x.
Loop
Next I
Image1.Enabled = False 'Inhabilitarla para impedir que regrese a la posicin
inicial.
End Sub
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 posicin 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 cdigo de la aplicacin puede bajarse de Aqu.
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
End Sub
El cdigo del ejercicio completo puede bajarse de Aqu.
Option Explicit
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 coloclos en el Inventario por Orden
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 cdigo completo de la Aplicacin 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 cdigo del Mdulo es:
Option Explicit
Public Function CalcPago(capital As Currency, ao 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 apliacin es Excel
Const hdExcelObject = "Excel.Application"
Screen.MousePointer = vbHourglass
CalcPago = False
' crea la aplicacin en Excel donde se realizar el Clculo
Set excelapp = CreateObject(hdExcelObject)
'llama al mtodo pmt de Excel
cuota = excelapp.Pmt((interes / 100) / 12, ao * 12, -1 * capital)
excelapp.quit
Set excelapp = Nothing
CalcPago = True
Screen.MousePointer = vbDefault
Exit Function
repararerror:
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 intrvalo, 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 nmero de carta, Borrar el lado B
Text3.Text = indice
Text1.Text = ladoA(indice)
Text2.Text = ""
' desactivar el botn lado A y activar el botn 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) = "Nihongo"
ladoB(1) = "Idioma Japons"
ladoA(2) = "Ohayo gozaimasu"
ladoB(2) = "Buenos Das"
ladoA(3) = "Kennichi wa"
ladoB(3) = "Hola o Buen Da"
ladoA(4) = "Konban wa"
ladoB(4) = "Buenas Tardes"
ladoA(5) = "Oyasumi nasai"
ladoB(5) = "Buenas Noches"
ladoA(6) = "Ja, mata ashita"
ladoB(6) = "Bien, nos veremos maana"
ladoA(7) = "Sayonara"
ladoB(7) = "Adis"
'activar el botn ladoA y desactivar el ladoB
Command1.Enabled = True
Command2.Enabled = False
End Sub
El cdigo completo de la Aplicacin 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)
Volver a Ejercicios
SndPlaySound
MCIExecute(Sonido)
MCIExecute(Video)
Ejercicio N 1: Sleep
Las API de Windows
(Application Programming
Interface) son funciones
automticas que ya trae
incorporadas el sistema
operativo Windows y que
podemos convocar para
programar en Visual Basic. De
esta manera ahorramos
recursos y programamos en un
nivel de mayor complejidad.
Para esta aplicacin vamos a trabajar con un control Image para el jeep y dos
array de controles para los camellos. La idea es que el auto avance hasta que se
encuentre con un camello all se detiene, hasta que el camello salga del paso y
luego contina hasta el prximo obstculo. Para esto vamos a usar la API Sleep
que nos permite hacer la pausa, con poca programacin y sin usar controles
extras, como un Timer. Las declaraciones de las API las vamos a traer del Visor
de API de Visual Basic y las copiamos en un Mdulo de extensin .bas que
agregamos desde Proyecto, agregar Mdulo. El cdigo es el siguiente:
Para el Mdulo:
Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Para el Formulario:
Ejercicio N 2: SndPlaySound
En este ejercicio vamos a activar un sonido Wave, al terminar de cargarse un
Formulario, para esto vamos a usar la API SndPlaySound que ejecuta sonidos
Wave. La traemos desde el Visor de las API a la declaracin y la guardamos en un
Mdulo .bas como en el ejemplo anterior. Luego declaramos en el Formulario en
la parte de Declaraciones Generales una variable como entera llamada sonido. Y
la ejecutamos por cdigo en el procedimiento Activate del Formulario con la
siguiente sintxis:
sonido = App.Path(SndPlaySound & "\Sonido.wav")
En el archivo wav colocamos el nombre del sonido elegido y este debe estar en el
mismo directorio que el proyecto ya que estamos usando el objeto App de
Application.
Option Explicit
Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As
String) As Long
Private Sub Command1_Click()
Const sAVIFile As String = "c:\Filemove.avi"
Ejercicio N 5: Blend.
Option Explicit
'Este proyecto requiere de dos controles Picture
'Cada control debe tener una imagen, ambas deben ser distintas
Const AC_SRC_OVER = &H0
Private Type BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type
Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdc As Long,
ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long,
ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long,
ByVal lInt As Long, ByVal BLENDFUNCT As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (Destination As Any,
Source As Any, ByVal Length As Long)
Private Sub Form_Load()
Dim BF As BLENDFUNCTION, lBF As Long
'Cambiar el modo grfico para que se mantenga la imagen
Picture1.AutoRedraw = True
Picture2.AutoRedraw = True
'usar pixels con la Api
Picture1.ScaleMode = vbPixels
Picture2.ScaleMode = vbPixels
'asignar los parmetros
With BF
.BlendOp = AC_SRC_OVER
.BlendFlags = 0
.SourceConstantAlpha = 128
.AlphaFormat = 0
End With
'copia la funcin blend a una variable en memoria de tipo long
RtlMoveMemory lBF, BF, 4
'aplicar la Api desde la picture1 sobre la picture2
AlphaBlend Picture2.hdc, 50, 0, 100, 100, Picture1.hdc, 0, 0, Picture1.ScaleWidth,
Picture1.ScaleHeight, lBF
End Sub
El cdigo competo puede bajarse de Aqu.
Volver a Ejercicios
Microsoft
Windows
Common
Controls - 2 6.0, y
como vemos nos
despliegan hora y
fecha y un
calendario que
podemos
recorrer.
El ejercicio puede bajarse de Aqu.
Ahora Visual
Basic nos
permite, crear
controles en
tiempo de
ejecucin sin
necesidad de
hacerlo dentro de
un array, a partir
del primero
creado en tiempo
de diseo.
El cdigo es:
Private WithEvents cmdmiboton As CommandButton
Private Sub cmdmiboton_Click()
cmdmiboton.Caption = "Me hiciste Clic!"
End Sub
Private Sub Label2_Click()
Set cmdmiboton = Controls.Add("VB.commandbutton", "Button")
With cmdmiboton
.Visible = True
.Width = 3000
.Caption = "Qu Sorpresa!!"
.Top = 3000
.Left = 1000
End With
Label2.Enabled = False
End Sub
Primero hacemos Click en la Label que crea el botn y luego con el Click del
botn cambiamos su propiedad Caption.
El ejercicio completo lo podemos bajar de Aqu.
Ejercicio N 4: ImageCombo.
Este nuevo
control pertenece
al grupo de
componentes:
Microsoft
Windows
Common
Controls 6.0. Y
nos permite
desplegar
imgenes adems
de texto en un
Combo
desplegable.
Ejercicio N 5: Coolbar.
Este control
pertenece al
grupo Microsoft
Windows
Common
Controls 3 6.0, y
permite desplegar
una barra que
contenga otros
controles.
En este caso al hacer Click en el icono del Reloj despliega la hora. Estos
controles que se insertan dentro de la Coolbar pueden mantenerse flotantes o
fijos.
El cdigo es:
Private Sub Command1_Click()
Label1.Caption = Time
End Sub
Private Sub Form_Activate()
List1.AddItem "Chocolates"
List1.AddItem "Caramelos"
List1.AddItem "Chupetines"
List1.AddItem "Galletitas"
End Sub
En el caso de la Lista le agregamos distintos Items a travs del Mtodo AddItem
en tiempo de ejecucin.
El ejercicio puede bajarse de Aqu.
asignamos al
panel de la barra
correspondiente.
El cdigo correspondiente es:
Private Sub cmdAceptar_Click()
StatusBar1.Panels("Texto").Text = txtPanel
End Sub
Como vemos es muy sencillo, para asignarle un valor al panel correspondiente
debemos identificarlo con el nombre del mismo, determinado en la ventana
propiedades, para tener acceso al mismo debemos hacer click con el boton
derecho sobre el control y alli podemos configurar los distintos paneles.
El ejercicio puede bajarse de AQU.
Ejercicio N 8: Pestaas.
Es comn usar el
control TabStrip
para mostrar
aplicaciones con
pestaas, sin
embargo es
mucho ms
potente el control
Tabbed Dialog ya
que cada panel
puede contener
otros controles,
esto facilita el
diseo y su
codificacin.
En el formulario dibujamos un control SStab traido de componentes y luego en
su primer pestaa dibujamos varias labels que nos vincularan con las otras
pestaas, donde se mostrar en una texto y en la otrs una imagen. El cdigo es el
siguiente:
Option Explicit
Private Sub Form_Load()
SSTab1.Tab = 0 'esto hace que se muestre el primer panel
End Sub
Private Sub
Label1_Click()
Text1.Text = "Aqui podemos cargar un texto con formato richtextbox, sobre el
Tema 1."
SSTab1.Tab = 1
End Sub
Ejercicio N 9: ListView.
Este control nos
permite desplegar
una lista de
archivos al estilo
el Explorador de
Windows. En este
caso los
agregamos a
traves del ingreso
de datos de cajas
de texto. Y
despliegan un
icono al azar
seleccionado de
un control
ImageList, que
hemos usado en
otros ejercicios.
El formulario,
permite a traves
del uso de
botones de
opcion
seleccionar que
modalidad
queremos que
tengan los
iconos.
El cdigo es el siguiente:
Option Explicit
Function NroAzar(Min As Integer, Max As Integer) As Integer
NroAzar = Int((Max - Min + 1) * Rnd + Min)
End Function
Private Sub cmdAgregar_Click()
Dim Nuevo As ListItem
Dim IndiceIcono As Integer
'Elegir un icono al azar para el elemento
IndiceIcono = NroAzar(1, ilIconos.ListImages.Count)
'Agregar el nuevo elemento, y asignarle el icono elegido
Set Nuevo = lvwPersonas.ListItems.Add(, , txtNombre, IndiceIcono, IndiceIcono)
Nuevo.SubItems(1) = txtEdad
Nuevo.SubItems(2) = txtSexo
Nuevo.SubItems(3) = txtTelefono
End Sub
Private Sub cmdEliminar_Click()
lvwPersonas.ListItems.Remove lvwPersonas.SelectedItem.Index
End Sub
Private Sub cmdSalir_Click()
End
End Sub
Private Sub optVista_Click(Index As Integer)
'Cambiamos el tipo de vista en View
lvwPersonas.View = Index
End Sub
Elegimos un Icono al azar de un ImageList el texto lo ingresamos a traves de las
Cajas de Texto. Tenemos dos botones con la opcion de Agregar y de Borrar, los
ingresos. Y Botones de Opcion para seleccionar la propiedad View de la Lista
acorde al Indice del option Button. los iconos que se muestran en los
encabezados fueron asignados al ingresar el Nombre de las columnas y
asociando la propiedad Icon Index a los Iconos de la ImageList ilColumnas. o sea
que tenemos dos controles ImageList.
Este ejercicio
muestra un tipico
arbol de archivos
de windows con
su raz principal y
sus derivados.
Acompaado de
Iconos tomados
tambin de un
control ImageList.
El mtodo Add,
agrega un Nodo
al arbol de
Archivos.
El cdigo es:
Option Explicit
Private Sub Arbol_Click()
lblActual = Arbol.SelectedItem.Text
End Sub
Private Sub cmdSalir_Click()
End
End Sub
Private Sub Form_Load()
Dim i As Integer
Arbol.Nodes.Add , , "Raiz", "Nodo raiz", 1
For i = 1 To 3
Arbol.Nodes.Add "Raiz", tvwChild, "Hijo " & i, "Hijo " & i, (i + 1)
Next i
Arbol.Nodes.Add "Hijo 1", tvwChild, "Nieto 1", "Nieto 1", 5 Arbol.Nodes.Add
"Nieto 1", tvwNext, "Nieto 2", "Nieto 2", 6 Arbol.Nodes.Add "Nieto 1",
tvwPrevious, "Nieto 0", "Nieto 0", 7
End Sub
El ejercicio completo puede bajarse de Aqu.
El control
Miscrosoft Chart
nos permite
desplegar
grficos
asociados a
determinados
datos que
podemos cargar
de otros archivos
como puede ser
una planilla de
Excel o una Base
de datos, o
determinarlos por
cdigo.
El control lo traemos de Componentes. Y al dibujarlo en el formulario vamos a ver
que contiene de manera predeterminada un grfico con datos apcrifos para
mostarnos su diseo.
Como organiza los datos: El control MSChart requiere que todos los datos se
organicen en filas y columnas. Adems requiere saber cuntos puntos de datos
habr en cada fila y columna que debe graficar. Por lo general se cuenta con una
columna de datos con mltiples filas (algo parecido a un alista de nmeros). Por
ejemplo: si se desean graficar las ventas de una empresa durante los ltimos
doce meses, contar con una sola columna(un ao) y doce filas(una por cada
mes). Si desea comparar los dos ltimos aos, tendr dos columnas (una por
cada ao) y doce filas(una por cada mes). Para poder organizar los datos usamos
las propieddaes ColumnCount y RowCount. En el ejemplo mencionado:
ColumnCount= 1
RowCount= 12
ChartType= 1 (vtChChartType2dBar)
Para agregar datos en tiempo de diseo: capturamos 12 cifras en tiempo de
diseo para poder apreciar el grfico. establecemos la propiedad AutoIncremente
a True y en la propiedad Data asignamos el valor 1, 2 o 3 para incrementar. Hagan
la prueba, de esa manera carga datos de manera automtica.
Vamos a hacer un primer ejercicio viendo las propiedades y siguiendo un poco el
ejemplo anterior:
Option Explicit
Dim data(1 To 5, 1 To 3) As String
Dim i As Integer
Dim m As Integer
Private Sub Form_Load()
Randomize
'Establece la cantidad de filas
MSChart1.RowCount = 3
.Size = 10
.VtColor.Set 125, 150, 155
End With
'Con la propiedad ChartType podemos cambiar el tipo de grafico.
'Por ejemplo: vtChChartType3dBar: es un grafico de Barras en 3D.
'Tambien podemos crear un array de 2 dimensiones (una tabla) y graficarla.
For i = 1 To 5
For m = 1 To 3
data(i, m) = Rnd * 100
Next m
Next i
MSChart1.ChartData = data
End Sub
.Top = 0
.Width = Me.ScaleWidth
.Height = Me.ScaleHeight
End With
End Sub
Private Sub mnuArchivoGuardar_Click()
Dim strArchivoGuardar As String
strArchivoGuardar = App.Path & "\" & App.EXEName & ".bmp"
MSChart1.EditCopy
SavePicture Clipboard.GetData, strArchivoGuardar
MsgBox "El grfico ha sido guardado en " & strArchivoGuardar, vbInformation,
"Guardar Grfico"
End Sub
Private Sub mnuArchivoImprimir_Click()
MSChart1.EditCopy
Printer.PaintPicture Clipboard.GetData, 0, 0
Printer.NewPage
Printer.EndDoc
MsgBox "El grfico ha sido enviado para su impresin.", vbInformation, "Imprimir
grfico"
End Sub
Private Sub mnuArchivoSalir_Click()
Unload Me
End Sub
Private Sub mnuEdicionCopiar_Click()
MSChart1.EditCopy
MsgBox "El grfico se copiado a la memoria.", vbInformation, "Copia de grfico"
End Sub
Private Sub mnuGraficosBaseDatos_Click()
'abrimos una conexion a datos con el uso de un proveedor OLEDB 'cuidado con
la ruta donde esta la base de datos.
End Sub
Private Sub mnuGraficosMatriz_Click()
Dim avarDatos(0 To 3, 1 To 5) As Variant
Dim intCol As Integer
Dim intFila As Integer
'carga las leyendas y los datos
With MSChart1
.chartType = VtChChartType3dBar
.ColumnCount = 6
.RowCount = 12
'los bucles generan los datos de la matriz dimensionada como variant
For intCol = 1 To 5
For intFila = 1 To 3
If intCol = 1 Then
avarDatos(intFila, intCol) = "trim" & CStr(intFila + 1)
Else
avarDatos(intFila, intCol) = Int((50 - 10 + 1) * Rnd + 10)
End If
Next
Next
.ShowLegend = True
End With
'asigna los datos al control chart
MSChart1.ChartData = avarDatos
End Sub
Private Sub mnuGraficosPuntos_Click()
Dim intCol As Integer
Dim intFila As Integer
With MSChart1
.chartType = VtChChartType3dBar
.ColumnCount = 6
.RowCount = 12
For intCol = 1 To 6
For intFila = 1 To 12
.Column = intCol .Row = intFila
.Data = intCol * intFila
Next
Next .ShowLegend = True
End With
End Sub
' Los valores de la columna A llenan la primera serie de las ' matriz. Si estos
valores son cadenas, se convierten
' las etiquetas de las filas.
matrizDatos(i, 1) = wkbObj.Worksheets(1) _ .Range("A" & i + 1).Value
' Despus los valores de la columna B llenan la segunda.
matrizDatos(i, 2) = wkbObj.Worksheets(1) _ .Range("B" & i + 1).Value
Next i
MSChart1.ChartData = matrizDatos
End Sub
Los cdigos de los tres ltimos ejercicios que usan el Control Chart pueden
bajarse de AQU.
En esta pantalla
seleccionamos
qu tipo de base
de datos vamos a
usar, si una de
Access o de un
servidor remoto.
En este caso
elegimos Access.
Y pasamos a la
pantalla
siguiente.
En esta pantalla
si hacemos Click
en el botn
Examinar
podemos elegir la
base de datos
que vamos a
usar.
En esta pantalla
seleccionamos la
tabla de la base
de datos. Y de
ella los campos
que queremos
mostrar. Los
seleccionamos y
con los botones
con flecha los
vamos pasando a
la lista de la
derecha. Si
queremos
ordenar los datos
por un campo
determinado lo
elegimos del
combo
desplegable.
Aqui hacemos
Click en
seleccionar todos
los botones o
elegimos solo
algunso. estos
nos permiten
navegar la grilla.
La pantalla
Siguiente nos
pregunta si
queremos
guardar esta
configuracin
como una
plantilla para
futuros
formularios.
Luego hacemos
Finalizar.
Al cerrase la
ventana del
Asistente
veremos en
nuestro proyecto
estndar un
nuevo formulario,
si no usamos el
primero o Form1
lo podemos
eliminar.
Posicionados en la ventana proyecto con el botn derecho tenemos la opcin de
eleminarlo. Y grabamos la aplicacin con el formulario que cre el asistente. Sino
lo usamos como formulario de presentacin. Como vemos en la ventana cdigo
el asistente, ya codific los botones de navegacin y de cierre de la Aplicacin.
El ejercicio completo podemos bajarlo de Aqu.
Visual Basic en
su versin 6
cuenta con un
tipo de proyecto
que nos permite
crear un archivo
con extensin
html y por lo
tanto al
ejercutarlo, se
abre en el
navegador, para
esto crea una .dll
donde convierte
el codigo visual
basic a htm.
Como vemos en la imagen debemos elegir en proyecto Nuevo: Aplicacin DHTML
(Dinamic Html). Tenemos aqu tambin una caja de herramientas y una ventana
diseo y otra ventana cdigo aunque con ciertas modificaciones, en el nombre de
los objetos y en sus procedimientos. Vamos a hacer el tpico ejemplo de Hola
Mundo pero en este editor de cdigo HTML. La aplicacin en tiempo de ejecucin
abre una pgina web con las siguientes caractersticas:
Vamos a dibujar
un control image,
un botn y una
caja de texto,
modificamos sus
propiedades a
travs de la
ventana
propiedades, y
luego
codificamos en la
ventana cdigo,
la sintxis es la
siguiente:
Ahora vamos a
hacer una
calculadora
simple de
operaciones
matemticas.
Abrimos un
nuevo proyecto
DHTML y
dibujamos una
tabla con
etiquetas y cajas
de texto y cinco
botones. En
tiempo de
ejecucin se ve
como la imagen
de la izquierda. Y
la codificacin es
la siguiente:
Dim numero1 As Integer
Dim numero2 As Integer
Private Sub BaseWindow_onload()
TextField1.Select
End Sub
Private Function Button1_onclick() As Boolean
numero1 = TextField1.Value
numero2 = TextField2.Value
TextField3.Value = Val(numero1 + numero2)
End Function
Private Function Button2_onclick() As Boolean
numero1 = TextField1.Value
numero2 = TextField2.Value
TextField3.Value = Val(numero1 - numero2)
End Function
Private Function Button3_onclick() As Boolean
numero1 = TextField1.Value
numero2 = TextField2.Value
TextField3.Value = Val(numero1 * numero2)
End Function
Private Function Button4_onclick() As Boolean
numero1 = TextField1.Value
numero2 = TextField2.Value
TextField3.Value = Val(numero1 / numero2)
End Function
Private Function Button5_onclick() As Boolean
TextField1.Value = ""
TextField2.Value = ""
TextField3.Value = ""
End Function
Los dos ejercicios que usan el diseador de paginas web pueden bajarlos de
Aqu.