Visual Basic 6.0

En este blogger encontraremos distintos codigos para la realizacion de programas en Visual Basic, veremos los codigos y las imagenes del Form en si como quedaria para cada programa.

Codigo para introducir contraseña y cambiarla

En este programa convinaremos dos. Uno que va a ser el principal donde se introducira, cambiara la contraseña y el otro donde solo se cambiara.

A continuacion veremos el codigo principal:



Dim d, f, a, r, s As Double
Private Sub Command1_Click()

If (a <> 3) Then
If (f = d) Then
Load mov
mov.Show
Unload Me
Else
MsgBox (" Error... Ingrese bien la contraseña")
a = a + 1
End If
Else
End
End If
End Sub

Private Sub Command2_Click()
Label3.Visible = True
Label4.Visible = True
Label5.Visible = True
Text2.Visible = True
Text3.Visible = True
Text4.Visible = True
Command4.Visible = True

End Sub

Private Sub Command3_Click()
End
End Sub

Private Sub Command4_Click()
If r = s And r <> 1991 Then
d = r
End If
End Sub

Private Sub Form_Load()
d = 1991
End Sub

Private Sub Text1_Change()
If Text1 <> " " Then
f = Val(Text1.Text)
End If
End Sub

Private Sub Text2_Change()
If Text2 <> " " Then
r = Val(Text2.Text)
End If
End Sub

Private Sub Text3_Change()
If Text3 <> " " Then
s = Val(Text3.Text)
End If
End Sub


Y el codigo secundario el de cambiar la contraseña:


Dim a, b, c, d As Integer
Private Sub Command1_Click()
If (a = b) Then
d = c
Else
MsgBox ("Ingrese bien la contraseña")
End If
Load contraseña
contraseña.Show
Unload Me
End Sub

Private Sub Text1_Change()
a = Val(Text1.Text)

End Sub

Private Sub Text2_Change()
b = Val(Text2.Text)
End Sub

Private Sub Text3_Change()
c = Val(Text3.Text)
End Sub

Codigo para realizar una tabla de multiplicar

Dim resultado As Double
Dim num, lim As Double

Private Sub Botonborrar_Click()
Limite.Text = " "
Numero.Text = " "
Tabla.Clear
num = 0
lim = 0
Numero.SetFocus
End Sub

Private Sub Botoncalcular_Click()

If Numero.Text = " " Then
MsgBox "Debe digitar un numero", 32, "Error"
Numero.SetFocus
Else
For cont = 1 To lim
resultado = num * cont
Tabla.AddItem " " & num & " x " & cont & " = " & resultado
Next
End If
End Sub

Private Sub Botonsalir_Click()
End
End Sub

Private Sub Form_Load()
Numero.Text = " "
End Sub


Private Sub Limite_Change()
If Numero.Text <> " " Then
lim = Limite.Text
End If
End Sub

Private Sub Limite_KeyPress(KeyAscii As Integer)
If KeyAscii <> 57 Then
KeyAscii = 0
End If
End Sub

Private Sub Numero_Change()
If Numero.Text <> " " Then
num = Numero.Text
End If
End Sub

Private Sub Numero_KeyPress(KeyAscii As Integer)
If KeyAscii <> 57 Then
KeyAscii = 0
End If
End Sub

Codigo para la sumatoria de un numero dado

Dim res, num1, cont As Double

Private Sub Command1_Click()

For cont = 0 To num1
res = res + cont
Text2.Text = res
Next


End Sub

Private Sub Command2_Click()
Text1.Text = " "
Text2.Text = " "
Text1.SetFocus
res = 0
num1 = 0
cont = 0
End Sub

Private Sub Command3_Click()
End
End Sub

Private Sub Text1_Change()
If Text1.Text <> " " Then
num1 = Val(Text1.Text)
End If
End Sub

Codigo para transformar segundos a minutos

Dim num1, resp, resp2 As Double

Private Sub Command1_Click()
If num1 Mod 60 = 0 Then
resp2 = num1 / 60
Label2.Caption = "Hay " & resp2 & " minuto(s)"
Else
resp = -(num1 Mod 60) + 60
If (num1 Mod 60) = 0 Then
resp2 = ((resp + num1) / 60)
Else
resp2 = ((resp + num1) / 60)
End If
Label2.Caption = "Faltan " & resp & " segundos para completar " & resp2 & " minuto(s)"
End If
End Sub

Private Sub Command2_Click()
Text1.Text = " "
Label2.Caption = " "
Text1.SetFocus
num1 = 0
resp = 0
End Sub

Private Sub Command3_Click()
End
End Sub

Private Sub Text1_Change()
If Text1.Text <> " " Then
num1 = Val(Text1.Text)
End If
End Sub

Codigo para calcular area y volumen de un cilindro

Dim num1, num2, resp As Double
Const pi As Double = 3.1416

Private Sub Command1_Click()
resp = 2 * pi * num1 * (num1 * num2)
Text3.Text = resp
End Sub

Private Sub Command2_Click()
resp = pi * num1 * num1 * num2
Text4.Text = resp
End Sub

Private Sub Command3_Click()
Text1.Text = " "
Text2.Text = " "
Text3.Text = " "
Text4.Text = " "
Text1.SetFocus
End Sub

Private Sub Command4_Click()
End
End Sub

Private Sub Text1_Change()
If Text1.Text <> " " Then
num1 = Val(Text1.Text)
End If
End Sub

Private Sub Text2_Change()
If Text2.Text <> " " Then
num2 = Val(Text2.Text)
End If
End Sub

Codigo para ordenar 4 numeros de mayor a menor

Dim num1, num2, num3, num4 As Integer
Dim mayor, medio, menor, medio1 As Double


Private Sub Command1_Click()
If num1 = num2 And num2 = num3 And num3 = num4 And num1 = num4 Then
Label10.Caption = "todos los numeros son iguales"
Else
If num1 = num2 And num2 = num3 Then
Label10.Caption = "primero, segundo y tercero son iguales"
If num2 > num4 Then
mayor = num2
menor = num4
Else: mayor = num4
menor = num2
End If
Label5.Caption = "Numero mayor: " & mayor
Label6.Caption = "Numero menor: " & menor
Else
If num1 = num2 And num2 = num4 Then
Label10.Caption = "primero, segundo y cuarto son iguales"
If num2 > num3 Then
mayor = num2
menor = num3
Else: mayor = num3
menor = num2
End If
Label5.Caption = "Numero mayor: " & mayor
Label6.Caption = "Numero menor: " & menor
Else
If num1 = num3 And num3 = num4 Then
Label10.Caption = "primero, tercero y cuarto son iguales"
If num1 > num2 Then
mayor = num1
menor = num2
Else: mayor = num2
menor = num1
End If
Label5.Caption = "Numero mayor: " & mayor
Label6.Caption = "Numero menor: " & menor
Else
If num2 = num3 And num3 = num4 Then
Label10.Caption = "segundo, tercero y cuarto son iguales"
If num1 > num2 Then
mayor = num1
menor = num2
Else: mayor = num2
menor = num1
End If
Label5.Caption = "Numero mayor: " & mayor
Label6.Caption = "Numero menor: " & menor
Else
If num1 = num2 Then
Label10.Caption = "primero y el segundo son iguales"
If num1 > num3 And num1 > num4 Then
mayor = num1
If num3 > num4 Then
medio = num3
menor = num4
Else:
medio = num4
menor = num3
End If
End If
Label5.Caption = "Numero mayor: " & mayor
Label6.Caption = "Numero medio: " & medio
Label7.Caption = "Numero memor: " & menor
Else
If num1 = num3 Then
Label10.Caption = "primero y el tercero son iguales"
If num1 > num2 And num1 > num4 Then
mayor = num1
If num2 > num4 Then
medio = num2
menor = num4
Else:
medio = num4
menor = num2
End If
End If
Label5.Caption = "Numero mayor: " & mayor
Label6.Caption = "Numero medio: " & medio
Label7.Caption = "Numero menor: " & menor
Else
If num1 = num4 Then
Label10.Caption = "primero y el cuarto son iguales"
If num1 > num3 And num1 > num2 Then
mayor = num1
If num3 > num2 Then
medio = num3
menor = num2
Else:
medio = num2
menor = num3
End If
End If
Label5.Caption = "Numero mayor: " & mayor
Label6.Caption = "Numero medio: " & medio
Label7.Caption = "Numero menor: " & menor
Else
If num2 = num3 Then
Label10.Caption = "segundo y tercero son iguales"
If num2 > num1 And num2 > num4 Then
mayor = num2
If num1 > num4 Then
medio = num1
menor = num4
Else
medio = num4
menor = num1
End If
End If
Label5.Caption = "Numero mayor: " & mayor
Label6.Caption = "Numero medio: " & medio
Label7.Caption = "Numero menor: " & menor
Else
If num2 = num4 Then
Label10.Caption = "segundo y cuarto son iguales"
If num2 > num1 And num2 > num3 Then
mayor = num2
If num1 > num3 Then
medio = num1
menor = num3
Else
medio = num3
menor = num1
End If
End If
Label5.Caption = "Numero mayor: " & mayor
Label6.Caption = "Numero medio: " & medio
Label7.Caption = "Numero menor: " & menor
Else
If num3 = num4 Then
Label10.Caption = "tercero y cuarto son iguales"
If num3 > num1 And num3 > num2 Then
mayor = num3
If num1 > num2 Then
medio = num1
menor = num2
Else
medio = num2
menor = num1
End If
End If
Label5.Caption = "Numero mayor: " & mayor
Label6.Caption = "Numero medio: " & medio
Label7.Caption = "Numero menor: " & menor


Else
If num1 <> num2 And num1 <> num3 And num1 <> num4 And num2 <> num3 And num2 <> num4 And num3 <> num4 Then
Label10.Caption = " "
If num1 > num2 And num1 > num3 And num1 > num4 Then
mayor = num1
If num2 > num3 And num2 > num4 And num3 > num4 Then
medio = num2
medio1 = num3
menor = num4
Else
If num2 > num3 And num2 > num4 And num4 > num3 Then
medio = num2
medio1 = num4
menor = num3
Else
If num3 > num2 And num3 > num4 And num2 > num4 Then
medio = num3
medio1 = num2
menor = num4
Else
If num3 > num2 And num3 > num4 And num4 > num2 Then
medio = num3
medio1 = num4
menor = num2
Else
If num4 > num3 And num4 > num2 And num3 > num2 Then
medio = num4
medio1 = num3
menor = num2
Else
medio = num4
medio1 = num2
menor = num3
End If
End If
End If
End If
End If

ElseIf num2 > num1 And num2 > num3 And num2 > num4 Then
mayor = num2
If num1 > num3 And num1 > num4 And num3 > num4 Then
medio = num1
medio1 = num3
menor = num4
Else
If num1 > num3 And num1 > num4 And num4 > num3 Then
medio = num1
medio1 = num4
menor = num3
Else
If num3 > num1 And num3 > num4 And num1 > num4 Then
medio = num3
medio1 = num1
menor = num4
Else
If num3 > num1 And num3 > num4 And num4 > num1 Then
medio = num3
medio1 = num4
menor = num1
Else
If num4 > num3 And num4 > num1 And num3 > num1 Then
medio = num4
medio1 = num3
menor = num1
Else
medio = num4
medio1 = num1
menor = num3
End If
End If
End If
End If
End If

ElseIf num3 > num1 And num3 > num2 And num3 > num4 Then
mayor = num3
If num1 > num2 And num1 > num4 And num2 > num4 Then
medio = num1
medio1 = num2
menor = num4
Else
If num1 > num2 And num1 > num4 And num4 > num2 Then
medio = num1
medio1 = num4
menor = num2
Else
If num2 > num1 And num2 > num4 And num1 > num4 Then
medio = num2
medio1 = num1
menor = num4
Else
If num2 > num1 And num2 > num4 And num4 > num1 Then
medio = num2
medio1 = num4
menor = num1
Else
If num4 > num2 And num4 > num1 And num2 > num1 Then
medio = num4
medio1 = num2
menor = num1
Else
medio = num4
medio1 = num1
menor = num2
End If
End If
End If
End If
End If

ElseIf num4 > num1 And num4 > num2 And num4 > num3 Then
mayor = num4
If num1 > num2 And num1 > num3 And num2 > num3 Then
medio = num1
medio1 = num2
menor = num4
Else
If num1 > num2 And num1 > num3 And num3 > num2 Then
medio = num1
medio1 = num3
menor = num2
Else
If num2 > num1 And num2 > num3 And num1 > num3 Then
medio = num2
medio1 = num1
menor = num3
Else
If num2 > num1 And num2 > num3 And num3 > num1 Then
medio = num2
medio1 = num3
menor = num1
Else
If num3 > num2 And num3 > num1 And num2 > num1 Then
medio = num3
medio1 = num2
menor = num1
Else
medio = num3
medio1 = num1
menor = num2
End If
End If
End If
End If
End If
End If

End If
End If
End If
End If
End If
End If
End If
End If

Label5.Caption = "Numero mayor: " & mayor
Label6.Caption = "Numero Medio mayor: " & medio
Label7.Caption = "Numero medio menor: " & medio1
Label8.Caption = "Numero Menor: " & menor

End If
End If
End If
End If

mayor = 0
medio = 0
medio1 = 0
menor = 0


End Sub

Private Sub Command2_Click()
Text1.Text = " "
Text2.Text = " "
Text3.Text = " "
Text4.Text = " "
Label5.Caption = " "
Label6.Caption = " "
Label7.Caption = " "
Label8.Caption = " "
Label10.Caption = " "
Text1.SetFocus
mayor = 0
menor = 0
medio = 0
medio1 = 0
End Sub

Private Sub Command3_Click()
End
End Sub

Private Sub Text1_Change()
If Text1.Text <> " " Then
num1 = Val(Text1.Text)
End If
End Sub

Private Sub Text2_Change()
If Text2.Text <> " " Then
num2 = Val(Text2.Text)
End If
End Sub

Private Sub Text3_Change()
If Text3.Text <> " " Then
num3 = Val(Text3.Text)
End If
End Sub

Private Sub Text4_Change()
If Text4.Text <> " " Then
num4 = Val(Text4.Text)
End If
End Sub

Codigo para calcular cuadrado de un numero, conversor de unidades y temperatura

Dim d As Integer d es el diametro
Dim r As Integer r es el radio
Dim a As Double a es el area total
Const pi As Double = 3.1416

Private Sub Command1_Click()
d = Val(Text1.Text)
r = d / 2
a = pi * r * r
Text2.Text = a

End Sub

Private Sub Command2_Click()
Text1.Text = " "
Text2.Text = " "
Text1.SetFocus

End Sub

Private Sub Command3_Click()
End

End Sub

Codigo para desplazar una imagen de esquina a esquina

Private Sub Form_Click()
Do While (cara.Top + cara.Height) < Form1.ScaleHeight
cara.Top = cara.Top + 1
Loop
Do While (cara.Left + cara.Width) <= Form1.ScaleWidth
cara.Top = cara.Top - 1
cara.Left = cara.Left + 2
Loop
Do While (cara.Top + cara.Height) < Form1.ScaleHeight
cara.Top = cara.Top + 1
Loop
Do While (cara.Left + cara.Width) <= Form1.ScaleWidth
cara.Top = cara.Top - 1
cara.Left = cara.Left + 2
Loop
MsgBox (" llego al final")
cara.Top = 0
cara.Left = 0
End Sub

Codigo para crear una lista de numeros y ordenarlos

Dim a As Integer
Dim positivo, negativo, par, impar As Double

Private Sub Command1_Click()
For cont = 1 To 50
a = InputBox("ingrese un numero")
List1.AddItem a
If (a > 0) Then
positivo = positivo + 1
Label2.Caption = "Positivos = " & positivo
End If

If (a < 0) Then
negativo = negativo + 1
Label3.Caption = "Negativos = " & negativo
End If

If (a Mod 2 = 0) Then
par = par + 1
Label4.Caption = "Pares = " & par
End If

If (a Mod 2 <> 0) Then
impar = impar + 1
Label5.Caption = "Impares = " & impar
End If
Next
End Sub


Si se necesita una lista mas pequeña o en su lugar una lista mas grande lo unico que tienes que hacer es cambiar el numero de la cantidad de datos que decea guardar de 1 a 50 a una lista mas pequeña de 1 a 10 este numero lo cambiarias en la siguiente parte del codigo:
Private Sub Command1_Click()
For cont = 1 To 10

Codigo para hallar los minutos, horas y dias

Dim num1, m, h, d As Integer

Private Sub Command1_Click()

If Text1.Text <> " " Then
If num1 \ 60 = 0 And num1 \ 1440 = 0 Then
m = num1
Label2.Caption = "Hay " & m & " minutos"
ElseIf num1 \ 60 <> 0 And num1 \ 1440 = 0 Then
If num1 Mod 60 = 0 Then
h = num1 / 60
Label2.Caption = "Hay " & h & " horas"
Else
h = num1 \ 60
m = num1 Mod 60
Label2.Caption = "Hay " & h & " horas" & " con " & m & " minutos"
End If
ElseIf num1 \ 60 <> 0 And num1 \ 1440 <> 0 Then
If num1 Mod 1440 = 0 Then
d = num1 \ 1440
Label2.Caption = "Hay " & d & " dias"
ElseIf num1 Mod 1440 <> 0 And (num1 Mod 1440) Mod 60 = 0 Then
d = num1 \ 1440
h = (num1 Mod 1440) \ 60
Label2.Caption = "Hay " & d & " dia(s)" & " con " & h & " hora(s)"
ElseIf num1 Mod 1440 <> 0 And (num1 Mod 1440) Mod 60 <> 0 Then
d = num1 \ 1440
h = (num1 Mod 1440) \ 60
m = (num1 Mod 1440) Mod 60
Label2.Caption = "Hay " & d & " dia(s)" & " con " & h & " hora(s) y " & m & " minuto(s)"
End If
End If
Else
MsgBox ("Ingrese un numero")
Text1.SetFocus
End If
End Sub

Private Sub Command2_Click()
Text1.Text = " "
Label2.Caption = " "
Text1.SetFocus
num1 = 0
m = 0
d = 0
h = 0
End Sub

Private Sub Command3_Click()
End

End Sub

Private Sub Form_Load()
Text1.Text = " "
End Sub

Private Sub Text1_Change()
If Text1.Text <> " " Then
num1 = Val(Text1.Text)
End If
End Sub

Codigo para hallar el factorial de un numero

Dim res, num1, cont As Double

Private Sub Command1_Click()
res = 1

For cont = 1 To num1
res = res * cont
Text2.Text = res
Next


End Sub

Private Sub Command2_Click()
Text1.Text = " "
Text2.Text = " "
Text1.SetFocus

End Sub

Private Sub Command3_Click()
End
End Sub



Private Sub Text1_Change()
If Text1.Text <> " " Then
num1 = Val(Text1.Text)
End If
End Sub

Codigo para calcular ecuacion ax2+bx+c

Dim b As Double
Dim c As Double
Dim x1 As Double
Dim x2 As Double
Dim a As Double
Dim res As Double


Private Sub Command1_Click()
If a < 0 Then
a = a * -1
b = b * -1
c = c * -1
If b * b - 4 * a * c > 0 Then
x1 = (-b + Sqr(b * b - 4 * a * c)) / (2 * a)
x2 = (-b - Sqr(b * b - 4 * a * c)) / (2 * a)

Text4.Text = x1
Text5.Text = x2
Else
MsgBox ("Los valores no son validos")

End If
ElseIf b * b - 4 * a * c > 0 Then
x1 = (-b + Sqr(b * b - 4 * a * c)) / (2 * a)
x2 = (-b - Sqr(b * b - 4 * a * c)) / (2 * a)

Text4.Text = x1
Text5.Text = x2
Else
MsgBox ("Escriba bien los valores")
End If

End Sub

Private Sub Command2_Click()
Text1.Text = " "
Text2.Text = " "
Text3.Text = " "
Text4.Text = " "
Text5.Text = " "
Text1.SetFocus
a = 0
b = 0
c = 0

End Sub

Private Sub Command3_Click()
End
End Sub

Private Sub Text1_Change()
If Text1.Text <> " " Then
a = Val(Text1.Text)
End If
End Sub

Private Sub Text2_Change()
If Text2.Text <> " " Then
b = Val(Text2.Text)
End If
End Sub

Private Sub Text3_Change()
If Text3.Text <> " " Then
c = Val(Text3.Text)
End If
End Sub

Codigo para mover una imagen de izquierda a derecha

Private Sub Form_click()
Do While (carita.Left + carita.Width) < Form1.ScaleWidth
carita.Left = carita.Left + 10
Loop
carita.Left = 0
MsgBox ("termino")

End Sub

Codigo para realizar una calculadora

Dim opera As Byte
Dim num1, num2, resp As Double

Private Sub borrar_Click()
visor.Text = " "
num1 = 0
num2 = 0
resp = 0

End Sub

Private Sub Command1_Click()
num1 = Val(visor.Text)
resp = 9 / 5 * num1 + 32
visor.Text = resp

End Sub

Private Sub Command2_Click()
num1 = Val(visor.Text)
resp = 5 / 9 * (num1 - 32)
visor.Text = resp

End Sub

Private Sub Command3_Click()
num1 = Val(visor.Text)
resp = num1 + 273
visor.Text = resp

End Sub

Private Sub Command4_Click()
num1 = Val(visor.Text)
resp = num1 - 273
visor.Text = resp

End Sub

Private Sub Command5_Click()
num1 = Val(visor.Text)
resp = 5 / 9 * (num1 - 32) + 273
visor.Text = resp

End Sub

Private Sub Command6_Click()
num1 = Val(visor.Text)
resp = 9 / 5 * (num1 - 273) + 32
visor.Text = resp

End Sub

Private Sub Command7_Click()

resp = Val(visor.Text) * -1
visor.Text = resp

End Sub

Private Sub Command8_Click()
num1 = Val(visor.Text)
If num1 < num1 =" Sqr(num1)" text =" num1" num1 =" Val(visor.Text)" resp =" num1" text =" resp" num1 =" Val(visor.Text)" opera =" 4" text = " " num1 =" Val(visor.Text)" opera =" 5" text = " " num1 =" 0" num2 =" 0" resp =" 0" num2 =" Val(visor.Text)" opera =" 1" resp =" num1" opera =" 2" resp =" num1" opera =" 3" resp =" num1" opera =" 4" num2 =" 0" resp =" num1" opera =" 5" num2 =" 0" resp =" num1" opera =" 6" num2 =" 0" resp =" num1" opera =" 7" num2 =" 0" resp =" num1" text =" resp" num1 =" Val(visor.Text)" opera =" 6" text = " " num1 =" Val(visor.Text)" opera =" 3" text = " " text =" visor.Text" text =" visor.Text" text =" visor.Text" text =" visor.Text" text =" visor.Text" text =" visor.Text" text =" visor.Text" text =" visor.Text" text =" visor.Text" text =" visor.Text" num1 =" Val(visor.Text)" opera =" 7" text = " " num1 =" Val(visor.Text)" opera =" 2" text = " " num1 =" Val(visor.Text)" opera =" 1" text = " "> 57 Then
KeyAscii = 0
End If
End Sub

Codigo para ver si una persona es apta o no para presentar el servicio militar

Dim sexo As Integer
Dim nacion As Integer
Dim edad As Integer

Private Sub Command1_Click()
Text1.Text = " "
Text2.Text = " "
Text3.Text = " "
Text1.SetFocus
End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Command3_Click()
If edad > 17 And edad < sexo =" 1" nacion =" 1"> " " Then
edad = Val(Text1.Text)
End If
End Sub

Private Sub Text2_Change()
If Text2.Text <> " " Then
sexo = Val(Text2.Text)
End If
End Sub

Private Sub Text3_Change()
If Text3.Text <> " " Then
nacion = Val(Text3.Text)
End If
End Sub