Private Sub cmdverde_Click()
cmdrojo.Visible = False
End Sub

Private Sub cmdrojo_Click()
cmdverde.Visible = False
End Sub

Private Sub cmdseven_Click()
cmdrojo.Visible = True
cmdverde.Visible = True
End Sub

Private Sub cmdfondo_Click()
Form1.BackColor = QBColor(Rnd * 9)
End Sub

Private Sub cmdsifun_Click()
cmdrojo.Enabled = True
cmdverde.Enabled = True
cmdseven.Enabled = True
cmdfondo.Enabled = True
End Sub

Private Sub cmdnofun_Click()
cmdrojo.Enabled = False
cmdverde.Enabled = False
cmdseven.Enabled = False
cmdfondo.Enabled = False
End Sub

Dim x as Currency
Dim y as Currency
Dim c as Currency



Private Sub Borrar_Click()
Text1.Text = ""
Text2.Text = ""
Text2.Text = ""
End Sub

Private Sub Coseno_Click()
On Error Resume Next
x = Val(Text1.Text)
xr = x * 2 * 3.1416 / 360
c = Cos(xr)
Text3.Text = c
End Sub

Private Sub Cuadrado_Click()
On Error Resume Next
x = Val(Text1.Text)
c = x * x
Text3.Text = c
End Sub

Private Sub Divide_Click()
On Error Resume Next
x = Val(Text1.Text)
y = Val(Text2.Text)
c = x / y
Text3.Text = c
End Sub

Private Sub Elevado_Click()
On Error Resume Next
x = Val(Text1.Text)
y = Val(Text2.Text)
c = x ^ y
Text3.Text = c
End Sub

Private Sub Euro_Click()
On Error Resume Next
x = Val(Text1.Text)
c = x / 166.386
Text3.Text = c
End Sub


Private Sub Inverso_Click()
On Error Resume Next
x = Val(Text1.Text)
c = 1 / x
Text3.Text = c
End Sub

Private Sub Multipli_Click()
On Error Resume Next
x = Val(Text1.Text)
y = Val(Text2.Text)
c = x * y
Text3.Text = c
End Sub

Private Sub Peseta_Click()
On Error Resume Next
x = Val(Text1.Text)
c = x * 166.386
Text3.Text = c
End Sub

Private Sub Pitagoras_Click()
On Error Resume Next
x = Val(Text1.Text)
y = Val(Text2.Text)
c = Sqr(x * x + y * y)
Text3.Text = c
End Sub

Private Sub Raiz_Click()
On Error Resume Next
x = Val(Text1.Text)
c = Sqr(x)
Text3.Text = c
End Sub

Private Sub Resta_Click()
On Error Resume Next
x = Val(Text1.Text)
y = Val(Text2.Text)
c = x - y
Text3.Text = c
End Sub

Private Sub Seno_Click()
On Error Resume Next
x = Val(Text1.Text)
xr = x * 2 * 3.1416 / 360
c = Sin(xr)
Text3.Text = c
End Sub

Private Sub Subir_Click()
Text1.Text = Text3.Text
End Sub

Private Sub Suma_Click()
On Error Resume Next
x = Val(Text1.Text)
y = Val(Text2.Text)
c = x + y
Text3.Text = c
End Sub

Private Sub Tangente_Click()
On Error Resume Next
x = Val(Text1.Text)
xr = x * 2 * 3.1416 / 360
c = Tan(xr)
Text3.Text = c
End Sub

Alinear el contenido de los TextBox a la derecha.
Quitar su contenido en Propiedades Text =

On Error Resume Next significa que en caso de error, división por cero, valores alfanuméricos, etc,.. no salga ningún mensaje de error que interrumpa el programa, sino que continúe con la siguiente instrucción.

Subir lo que hace es poner el contenido del Text3 en el Text1

Los ángulo se pasan a radianes.

Dim x as Currency
Currency son variables de tipo monedas.

Si x fuese una variable Single y hacemos:

2/140 saldrá 1,42857142857143E-02

Si x es de tipo Currency:

2/140 = 0,0143

Private Sub cmdCalcula_Click()
a$ = "TRWAGMYFPDXBNJZSQVHLCKEI"
x = Val(txtdni.Text)
n = (x Mod 23) + 1
letra = Mid$(a$, n, 1)
txtNif.Text = x & "-" & letra
End Sub

Ponemos la dirección absoluta de un fichero existente en nuestro disco duro.

Lo enviamos o al directorio C:\Segur de nuestro disco duro, o a la carpeta Envio del Eqp20 de la red, o a ambos lugares.

La carpeta Envio debe estar compartida.

Private Sub Command1_Click()
a = Text1.Text
x = Timer
z = Int(Val(x))
b = "C:\Segur\" & z
c = "\\eqp20\envio\" & z

If Check1.Value = 1 Then FileCopy a, b
If Check2.Value = 1 Then FileCopy a, c
End Sub

Al fichero destino le cambiamos el nombre, le ponemos el Timer, o sea, el número de segundos que han pasado desde la media noche.
Esto lo hacemos para no recibir archivos con el mismo nombre.

Timer = segundos transcurridos desde la media noche.
\\eqp20\envio = Carpeta envio, que se encuentra en el eqp20 de la red

Se trata de escribir un texto y pulsar el botón Enviar para mandarlo a un Equipo de Red.

El contenido del Text1 se debe guardar en el archivo C:\borra.txt de tu disco duro (Machacando si ya hubiera otro texto)

Además se debe enviar a la carpeta compartida envio situada en un ordenador de red llamado eqp20 (\\eqp20\envio\)

El archivo enviado debe tener como nombre el Timer, o sea, la hora actual en segundos.

Para ello "cogemos" la hora actual
x = Timer, que es cadena de caracteres.
Lo pasamos a número (VAL) y tomamos la parte entera (INT)

El valor z será el nombre del archivo que enviemos.

Operaciones con archivos

Private Sub Command1_Click()
Open "C:\borra.txt" For Output As #1
Write #1, Text1.Text
Close #1

x = Timer
z = Int(Val(x))
c = "\\eqp20\envio\" & z
' c = "C:\" & z (Si no tienes red)

FileCopy "C:\borra.txt", c
End Sub

Poner un botón y
un PictureBox (pctdado)

Bájate el archivo comprimido dado.zip en donde encontrarás los dibujos del dado. Descomprímelo en la carpeta C:\Dado

Private Sub cmdPulsa_Click()


Randomize Timer
X = Int(6 * Rnd) + 1

Select Case X
Case 1
pctdado.Picture = LoadPicture("C:\Dado\dado1.bmp")
Case 2
pctdado.Picture = LoadPicture("C:\Dado\dado2.bmp")
Case 3
pctdado.Picture = LoadPicture("C:\Dado\dado3.bmp")
Case 4
pctdado.Picture = LoadPicture("C:\Dado\dado4.bmp")
Case 5
pctdado.Picture = LoadPicture("C:\Dado\dado5.bmp")
Case 6
pctdado.Picture = LoadPicture("C:\Dado\dado6.bmp")
End Select

End Sub

Cuando la línea de código es muy larga, la podemos continuar en la línea siguiente poniendo un guión _

Ejemplo :

If x = num Then txtrespuesta.Text = "Acertaste de " & n & " intentos.": cmdes.Enabled = False

La podemos escribir así, en dos líneas :

If x = num Then txtrespuesta.Text = "Acertaste de " & n & _
" intentos.": cmdes.Enabled = False

El guión _ es para un cambio de línea en el código fuente.

Fíjate en la Propiedad Enabled, se utiliza para anular el botón.

Dim num, x, n
Private Sub cmdes_Click()
n = n + 1
num = Val(txtnum.Text)
If x < num Then txtrespuesta.Text = "Mi número es menor."
If x > num Then txtrespuesta.Text = "Mi número es mayor."
If x = num Then txtrespuesta.Text = "Acertaste de " & n & _
" intentos.": cmdes.Enabled = False
End Sub

Private Sub Command1_Click()
Randomize Timer
x = Int(Rnd * 100)
n = 0
cmdes.Enabled = True
End Sub

Private Sub Form_Load()
cmdes.Enabled = False
End Sub

Dim dibujar As Boolean 


Private Sub Command1_Click()
Cls
End Sub


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

dibujar = True 
End Sub


Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
If optrojo = True Then Form1.ForeColor = vbRed
If optnegro = True Then Form1.ForeColor = vbBlack
If dibujar Then Line -(X, Y)

End Sub


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

dibujar = False 
End Sub

Dim a As Currency
Dim b As Currency
Dim c As Currency


Private Sub cmdCalcula_Click()
txtnegativo.Visible = False
a = Val(txta.Text)
b = Val(txtb.Text)
c = Val(txtc.Text)
r = b * b - 4 * a * c


If r < 0 Then

txtx1.Text = ""
txtx2.Text = ""
txtnegativo.Visible = True

Else

ra = Sqr(r)
X1 = (-b + ra) / (2 * a)
X2 = (-b - ra) / (2 * a)
txtx1.Text = X1
txtx2.Text = X2

End If
End Sub

Private Sub Form_Load()
txtnegativo.Visible = False
End Sub

Resolución de una ecuación de 2º grado

Private Sub Form_Load()

Form.WindowState=2 ' Pantalla completa
Form.BorderStyle=0 ' Sin barra de Titulos
Timer1.Interval = 1  ' Pone intervalo
DrawWidth = 8   ' Grosor del punto
If App.PrevInstance Then Unload Me  
End Sub


Private Sub Timer1_Timer()
    
Randomize Timer()
X = Rnd * 12000
Y = Rnd * 9000
C = Rnd * 15
PSet (X, Y), QBColor(C) 

 
End Sub


Private Sub Form_Click()
Unload Me

' Cuando pulsa sobre el Formulario se descarga
End Sub

Hay una etiqueta sobre cada resistencia :
lblR1, lblR2 y lblR3

Se ha realizado de dos formas:

En la parte izquierda se efectúan los Calculos en cada Subrutina del Scroll.

En la parte derecha he creado una Subrutina llamada Calculos y la llamo cada vez que se realiza un Scroll.

Estúdia las dos formas.

Dim Rt As Currency


Private Sub hscR1_Change()
lblR1.Caption = hscR1.Value
R1 = Val(hscR1.Value)
R2 = Val(hscR2.Value)
R3 = Val(hscR3.Value)
Rp = (R2 * R3) / (R2 + R3)
lblRp.Caption = Rp
Rt = R1 + Rp
lblRt.Caption = Rt
End Sub


Private Sub hscR2_Change()
lblR2.Caption = hscR2.Value
R1 = Val(hscR1.Value)
R2 = Val(hscR2.Value)
R3 = Val(hscR3.Value)
Rp = (R2 * R3) / (R2 + R3)
lblRp.Caption = Rp
Rt = R1 + Rp
lblRt.Caption = Rt
End Sub


Private Sub hscR3_Change()
lblR3.Caption = hscR3.Value
R1 = Val(hscR1.Value)
R2 = Val(hscR2.Value)
R3 = Val(hscR3.Value)
Rp = (R2 * R3) / (R2 + R3)
lblRp.Caption = Rp
Rt = R1 + Rp
lblRt.Caption = Rt
End Sub

Dim Rt As Currency


Private Sub hscR1_Change()
lblR1.Caption = hscR1.Value
Calculos

End Sub


Private Sub hscR2_Change()
lblR2.Caption = hscR2.Value
Calculos

End Sub


Private Sub hscR3_Change()
lblR3.Caption = hscR3.Value
Calculos

End Sub


Private Sub Calculos()
R1 = Val(hscR1.Value)
R2 = Val(hscR2.Value)
R3 = Val(hscR3.Value)
Rp = (R2 * R3) / (R2 + R3)
lblRp.Caption = Rp
Rt = R1 + Rp
lblRt.Caption = Rt
End Sub

Sacar un TextBox. Marcar. Botón derecho. Copiar. Botón derecho. Pegar.
Te hace una pregunta:
¿Quieres crear una matriz de controles? Responde Sí.
Repetir el proceso de Pegar.

Habrás creado : Text1(0), Text1(1), Text1(2), Text1(3), Text1(4), Text1(5) ......Text1(14)

Todos son Text1 pero con distinto subíndice.

De tal manera que podemos localizar cualquiera de ellos mediante
Text1(n)

Este programa se basa en el de la quiniela visto en la página de QBASIC

Private Sub Command1_Click()
Randomize Timer
For n = 0 To 14
a = Int(Rnd * 6) + 1
If a < 4 Then r = "1": GoTo fin
If a > 5 Then r = "2": GoTo fin
r = "X"
fin:
Text1(n).Text = r
Next n

End Sub

InputBox se utiliza para introducir datos, se asigna a una variable, por ejemplo nom.

Si pulsamos Cancelar se toma nom como ""

MsgBox se utiliza para presentar una respuesta. Con las constantes vb podemos poner distintos botones y símbolos.

Private Sub Command1_Click()
nom = InputBox("Introduce tu nombre", "Datos")

If nom = "" Then
res = MsgBox("No válido", vbExclamation + vbOKOnly, "Repetir")
Else
res = MsgBox("Te llamas " & nom, vbInformation + vbOKOnly, "Respuesta")
End If
End Sub

' Aquí tienes otro ejemplo de respuestas del MsgBox


Private Sub Command1_Click()
pre = MsgBox("¿Te gustan los Beatles?", vbQuestion + vbYesNo, "Pregunto")

If pre = vbYes Then
res = MsgBox("Eres un carroza.", vbInformation + vbOKOnly, "Respuesta")
Else
res = MsgBox("Niñato moderno.", vbExclamation + vbOKOnly, "Respuesta")
End If
End Sub

Dim ya

Private Sub Command1_Click()
Timer1.Interval = 1
Text2.Visible = False
End Sub

Private Sub Command2_Click()
ya = "si"
End Sub

Private Sub Form_Load()
Text2.Visible = False
Timer1.Interval = 0
Randomize Timer
End Sub

Private Sub Timer1_Timer()
a = Int(Rnd * 3 + 1)
b = Int(Rnd * 3 + 1)
c = Int(Rnd * 3 + 1)
Text1(0).Text = a
Text1(1).Text = b
Text1(2).Text = c
If ya = "si" Then
Timer1.Interval = 0
If (Text1(0).Text = Text1(1).Text _
And Text1(1).Text = Text1(2).Text) _ 
Then Text2.Visible = True
End If
ya = ""
End Sub

Juego de máquina recreativa.

Cuando le das a Comienza, salen continuamente números 1, 2 y 3 en los casilleros, cuando pulsas Para, si los tres número son iguales sale el mensaje de Enhorabuena que estaba Visible=false.

Los TextBox deben ser TextBox1(0), TextBox1(1) y TextBox1(2)

En una casa hay contratado un servicio de potencia de 3.3 KW (Por el cuál se ha de pagar 1.394348 euro cada mes).
El KWh consumido se paga a 0.079213 Euro.
Además hay que pagar un impuesto sobre electricidad de 1.05113 x 4.864 %.
Y un I.V.A. del 16 %.
El recibo se hace cada 2 meses.
Este sería su recibo de energía, suponiendo que estos dos meses ha consumido 562 Kwh.

Private Sub Consumo_Change()

nPcontratada = Val(Pcontratada.Text)
nIPcontratada = nPcontratada * 2 * 1.394348
IPcontratada.Text = nIPcontratada

nConsumo = Val(Consumo.Text)
nIConsumo = nConsumo * 0.079213
IConsumo.Text = nIConsumo

nSubtotal = nIPcontratada + nIConsumo
Subtotal.Text = nSubtotal

nImpuestos = nSubtotal * 1.05113 * 4.864 / 100
Impuestos.Text = nImpuestos

nBaseImponible = nSubtotal + nImpuestos
BaseImponible.Text = nBaseImponible

nIVA = nBaseImponible * 0.16
IVA.Text = nIVA

nTotal = nBaseImponible + nIVA
Total.Text = nTotal

nPesetas = nTotal * 166.386
Pesetas.Text = nPesetas
End Sub

Este Proyecto se puede mejorar definiendo los tipos de variables y actuando sobre el redondeo. Pero se ha intentado realizar de una manera sencilla.

Para su funcionamiento debes cambiar sólamente el casillero de Consumo.

En este Proyecto ponemos una fecha, y nos calcula los dias pasados desde esa fecha y el día de la semana.

Los Textbox tienen como nombre Dia, Mes y Año respectivamente.

Donde está la palabra Miércoles se ha de poner una etiqueta llamada Dianaciste.

Donde está el número 4645 se ha de poner una etiqueta llamada Diasvividos.

DateSerial, convierte tres números en formato fecha.

WeekDay me dá el número de día de la semana.

DateDiff nos da la diferencia entre dos fechas, si ponemos "d" nos da los días de diferencia.

Now es la fecha actual.

Private Sub Command1_Click()
Dia = Dia.Text
Mes = Mes.Text
Año = Año.Text
Mifecha = DateSerial(Año, Mes, Dia)
semana = Weekday(Mifecha, vbMonday)
dias = DateDiff("d", Mifecha, Now)
Diasvividos.Caption = dias

Select Case semana
Case 1
Dianaciste.Caption = "Lunes"
Case 2
Dianaciste.Caption = "Martes"
Case 3
Dianaciste.Caption = "Miércoles"
Case 4
Dianaciste.Caption = "Jueves"
Case 5
Dianaciste.Caption = "Viernes"
Case 6
Dianaciste.Caption = "Sábado"
Case 7
Dianaciste.Caption = "Domingo"

End Select
End Sub