Factorial de un Número

Enviado por cacp_20

Private Sub Command1_Click()

Dim N, S, F

F = 1

N = Val(Text1)

For S = 1 To N

F = F * S

Text2 = F

End Sub

Private Sub Command2_Click()

Text2 = ""

Text1 = ""

Text1.SetFocus

End Sub

Private Sub Command3_Click()

End

End Sub

Private Sub Form_Load()

End Sub

Fórmula General

Dim a, b, c As Integer

Dim x1, x2, e As Double

Private Sub Command1_Click()

a = Val(Text1.Text)

b = Val(Text2.Text)

c = Val(Text3.Text)

e = (b ^ 2) – (4 * a * c)

If e < 0 Then

MsgBox "Raiz Imaginaria ", vbCritical, "Error De Calculo"

Command2_Click

Else

e = Sqr(e)

x1 = (-b + e) / (2 * a)

x2 = (-b – e) / (2 * a)

Text4.Text = Round(x1, 4)

Text5.Text = Round(x2, 4)

End If

End Sub

Private Sub Command2_Click()

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Text4.Text = ""

Text5.Text = ""

Text1.SetFocus

End Sub

Private Sub Command3_Click()

End

End Sub

Private Sub Form_Load()

End Sub

Private Sub Frame2_DragDrop(Source As Control, X As Single, Y As Single)

End Sub

Private Sub Frame3_DragDrop(Source As Control, X As Single, Y As Single)

End Sub

Grabar Nombre

Para ver el gráfico seleccione la opción "Descargar" del menú superior

Private Sub Command1_Click()

Dim reg As record

w = FreeFile

r = Val(Text1)

Open "c:registro.txt" For Random As #w Len = 150

reg.codigo = Val(Text2)

reg.nombre = Text3

Put w, r, reg

Text1 = ""

Text2 = ""

Text1.SetFocus

Text3 = ""

End Sub

Private Sub Command2_Click()

Dim reg As record

w = FreeFile

r = Val(Text1)

Open "c:registro.txt" For Random As #w Len = 150

reg.codigo = Val(Text2)

reg.nombre = Text3

Get w, r, reg

Text1 = r

Text2 = reg.codigo

Text3 = reg.nombre

Text1.SetFocus

End Sub

Private Sub Label1_Click()

End Sub

Modulo

Type record

codigo As Integer

nombre As String * 20

End Type

Números Impares

Para ver el gráfico seleccione la opción "Descargar" del menú superior

Private Sub Command1_Click()

Dim B

For B = 1 To 99 Step 2

List1.AddItem B

Next B

End Sub

Private Sub Command2_Click()

List1.Clear

End Sub

Private Sub Command3_Click()

End

End Sub

El Menor de tres Valores

Para ver el gráfico seleccione la opción "Descargar" del menú superior

Private Sub Comparar_Click()

Dim a, b, c As Double

If Val(Text1) < 0 Or Val(Text2) < 0 Or Val(Text3) < 0 Then

MsgBox "Solo Numeros Positivos", vbExclamation, "Casimiro Error De Valores"

Text1 = ""

Text2 = ""

Text3 = ""

Text1.SetFocus

Else

a = Val(Text1)

b = Val(Text2)

c = Val(Text3)

If a < b Then

If a < c Then

Label4.Caption = "Menor : " & a

Else

Label4.Caption = "Menor : " & c

End If

Else

If b < c Then

Label4.Caption = "Menor : " & b

Else

Label4.Caption = "Menor : " & c

End If

End Sub

Private Sub Form_Activate()

Text1.SetFocus

End Sub

Private Sub Salir_Click()

End

End Sub

Números Pares con sus cuadrados

y cubos

Para ver el gráfico seleccione la opción "Descargar" del menú superior

Private Sub Command1_Click()

List1.AddItem "PARES" & String(7, "*") & "CUADRADO" & String(15, "*") & "CUBO"

List1.AddItem "" & String(116, "'")

Dim A, B, C As Double

For A = 2 To 100 Step 2

B = A * A

C = B * A

List1.AddItem A & String(30, "-") & B & String(19, "-") & C

Next A

End Sub

Private Sub Command2_Click()

List1.Clear

End Sub

Private Sub Command3_Click()

End

End Sub

Números Primos

Para ver el gráfico seleccione la opción "Descargar" del menú superior

Private Sub Command1_Click( )

n = Val(Text1)

For s = 1 To n Step 2

c = 2

p = True

Do While c < s – 1 And p

If s Mod c = 0 Then

p = False

Else

c = c + 1

End If

Loop

If p Then

List1.AddItem s

End If

End Sub

Private Sub Command2_Click()

List1.Clear

Text1 = ""

Text1.SetFocus

End Sub

Private Sub Command3_Click()

End

End Sub

Registro

Para ver el gráfico seleccione la opción "Descargar" del menú superior

Private Sub Command1_Click()

Dim reg As record

w = FreeFile

r = Val(Text1)

Open "c:Registro.txt" For Random As #w Len = 200

reg.codigo = Val(Text2)

reg.matricula = Text3

reg.nombre = Text4

Put w, r, reg

Text1 = ""

Text2 = ""

Text3 = ""

Text4 = ""

Text1.SetFocus

End Sub

Private Sub Command2_Click()

Dim reg As record

w = FreeFile

r = Val(Text1)

Open "c:Registro.txt" For Random As #w Len = 200

reg.codigo = Val(Text2)

reg.matricula = Text3

reg.nombre = Text4

Get w, r, reg

Text1 = r

Text2 = reg.codigo

Text3 = reg.matricula

Text4 = reg.nombre

Text1.SetFocus

End Sub

Private Sub Command3_Click()

MsgBox "Antonio Castillo Se despide"

End

End Sub

Modulo

Type record

codigo As Integer

nombre As String * 25

Matricula As String * 13

End Type

El Mayor de dos Valores sin Números Negativos

Para ver el gráfico seleccione la opción "Descargar" del menú superior

Private Sub Command1_Click()

If Val(Text1) < 0 Or Val(Text2) < 0 Then

MsgBox "Inserte Un valor Positivo"

Text1 = ""

Text2 = ""

Text3 = ""

Text1.SetFocus

Else

If Val(Text1) > Val(Text2) Then

Text3 = "Este es Mayor: " & Val(Text1)

Else

If Val(Text1) < Val(Text2) Then

Text3 = " Este es mayor: " & Val(Text2)

Else

If Val(Text1) = Val(Text2) Then

Text3 = "No hay Mayores"

End If

End Sub

Private Sub Command2_Click()

Text1 = ""

Text2 = ""

Text3 = ""

MsgBox "Casimiro dice Inserte valores"

Text1.SetFocus

End Sub

Private Sub Command3_Click()

MsgBox "Ajaaa!, Conque Quieres Irte, Esta Bien bye"

End

End Sub

Calificaciones de estudiantes

Para ver el gráfico seleccione la opción "Descargar" del menú superior

Private Sub Borrar_Click()

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Text4.Text = ""

Text5.Text = ""

Text6.Text = ""

Text7.Text = ""

Text1.SetFocus

End Sub

Private Sub Calificacion_Click()

Dim AST, PP, EF, EP, NO As Integer

Dim L As String * 2

AST = Val(Text3)

PP = Val(Text4)

EP = Val(Text5)

EF = Val(Text6)

NO = AST + PP + EF + EP

Text7 = NO

Select Case NO

Case 0 To 49: L = "F"

Case 50 To 59: L = "FI"

Case 60 To 69: L = "FE"

Case 70 To 74: L = "D"

Case 75 To 79: L = "C"

Case 80 To 89: L = "B"

Case 90 To 100: L = "A"

Case Is > 100: L = "Error"

End Select

Letra.Caption = "Letra : " & L

End Sub

Private Sub Form_Activate()

Text1.SetFocus

End Sub

Private Sub Salir_Click()

End

End Sub

Private Sub Text2_Change()

Text2.Text = UCase(Text2.Text)

Text2.SelStart = Len(Text2.Text)

End Sub

Guía Telefónica

Para ver el gráfico seleccione la opción "Descargar" del menú superior

Private Sub Command1_Click()

Dim reg As record

w = FreeFile

Open "c:guia.txt" For Random As #w Len = 200

r = Val(Text1)

reg.nombre = Text2

reg.telefono = Text3

reg.saldo = Text4

Put w, r, reg

Text2 = ""

Text3 = ""

Text4 = ""

Text1 = Val(Text1) + 1

Text1.SetFocus

End Sub

Private Sub Command2_Click()

Dim reg As record

w = FreeFile

Open "c:guia.txt" For Random As #w Len = 200

r = Val(Text1)

Get w, r, reg

Text2 = reg.nombre

Text3 = reg.telefono

Text4 = reg.saldo

End Sub

Private Sub Command3_Click()

Form1.Hide

Form2.Show

End Sub

Private Sub modulo()

Type record

nombre As String * 15

telefono As String * 8

saldo As Double

End Type

End Sub

Private Sub Command4_Click()

End

End Sub

Nómina de Pago

Para ver el gráfico seleccione la opción "Descargar" del menú superior

Private Sub Command1_Click()

afp = 0: club = 0: sm = 0: ss = 0: td = 0: SN = 0: coop = 0

cat = Val(Text3)

sb = Val(Text4)

Select Case cat

Case 1

ss = sb * 0.02

coop = sb * 0.03

Case 2

ss = sb * 0.03

coop = sb * 0.04

club = sb * 0.01

Case 3

sm = sb * 0.02

coop = sb * 0.04

club = sb * 0.02

afp = sb * 0.03

End Select

td = afp + coop + club + ss + sm

SN = sb – td

Text5 = "RD$ " & ss

Text6 = "RD$ " & coop

Text7 = "RD$ " & club

Text8 = "RD$ " & sm

Text9 = "RD$ " & afp

Text10 = "RD$ " & td

Text11 = "RD$ " & SN

End Sub

Private Sub Command2_Click()

Text1 = ""

Text2 = ""

Text3 = ""

Text4 = ""

Text5 = ""

Text6 = ""

Text7 = ""

Text8 = ""

Text9 = ""

Text10 = ""

Text11 = ""

Text1.SetFocus

End Sub

Private Sub Command3_Click()

End

End Sub

Tabla

Para ver el gráfico seleccione la opción "Descargar" del menú superior

Private Sub Command1_Click()

Dim N, R, S

N = Val(Text1)

For S = 1 To 12

R = N * S

List1.AddItem N & " x " & S & " = " & R

End Sub

Private Sub Command2_Click()

List1.Clear

Text1 = ""

Text1.SetFocus

End Sub

Private Sub Command3_Click()

End

End Sub

Todos los programas

Para ver el gráfico seleccione la opción "Descargar" del menú superior

Private Sub Borrar_Click()

List1.Clear

Text2 = ""

Text1 = ""

Text1.SetFocus

End Sub

Private Sub Cerrar_Click()

MsgBox "Cerrando el sistema"

End

End Sub

Private Sub der_Click()

Private Sub Factorial_Click()

Dim N, S, F

F = 1

N = Val(Text1)

For S = 1 To N

F = F * S

Text2 = F

End Sub

Private Sub fijonacis_Click()

Dim A, N

A = 0

N = 1

While A + B <= 100

A = A + N

N = N + A

List1.AddItem A

List1.AddItem N

Wend

End Sub

Private Sub Impares_Click()

Dim B As Double

List1.AddItem "Impares"

List1.AddItem ""

For B = 1 To 100 Step 2

List1.AddItem B

Next B

End Sub

Private Sub Pares_Click()

Dim A As Double

List1.AddItem "PARES"

List1.AddItem ""

For A = 2 To 100 Step 2

List1.AddItem A

Next A

End Sub

Private Sub Tabla_Click()

Dim N, R, S

N = Val(Text1)

For S = 1 To 12

R = N * S

List1.AddItem N & " x " & S & " = " & R

End Sub

Private Sub Titulo_Click()

Print " Universidad Dominicana O & M"

End Sub

Nómina de Profesores

Para ver el gráfico seleccione la opción "Descargar" del menú superior

Dim Nomina As Grabacion

Dim W, R As Integer

Dim SM, COOP, AFP, ISR, TD As Currency

Private Sub Calcular_Click()

Text6 = CCur(Val(Text5)) * Val(Text4)

With Seleccion

If .ListIndex = 0 Then

SM = Val(Text6) * 0.02

COOP = Val(Text6) * 0.03

AFP = Val(Text6) * 0.01

ISR = 0

ElseIf .ListIndex = 1 Then

SM = Val(Text6) * 0.03

COOP = Val(Text6) * 0.03

AFP = Val(Text6) * 0.02

ISR = Val(Text6) * 0.02

ElseIf .ListIndex = 2 Then

SM = Val(Text6) * 0.04

COOP = Val(Text6) * 0.05

AFP = Val(Text6) * 0.04

ISR = Val(Text6) * 0.04

End If

End With

TD = AFP + ISR + SM + COOP

Text7 = Val(Text6) – TD

End Sub

Private Sub Editar_Click()

If Not Text1 = "" Then

W = FreeFile

Open "C:Nomina.txt" For Random As #W Len = 120

R = Val(Text1)

Get W, R, Nomina

With Nomina

Text2 = .Codigo

Text3 = .Profesor

Text4 = .HT

Seleccion.Text = .Postgrado

Text5 = FormatCurrency(Val(.SH), 2)

Text6 = FormatCurrency(Val(.SB), 2)

Text7 = FormatCurrency(Val(.SN), 2)

End With

Close #W

End If

End Sub

Private Sub Form_Activate()

With RegNomina

.FontSize = 11

.ForeColor = vbYellow

End With

End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

SendKeys "{tab}"

End If

End Sub

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

Line1.Visible = False

Line2.Visible = False

Line3.Visible = False

Line4.Visible = False

Line5.Visible = False

Line6.Visible = False

Line7.Visible = False

Line8.Visible = False

End Sub

Private Sub Grabar_Click()

If Not Text1 = "" Then

W = FreeFile

Open "C:Nomina.txt" For Random As #W Len = 120

R = Val(Text1)

With Nomina

.Codigo = Val(Text2)

.Profesor = Text3

.HT = Val(Text4)

.Postgrado = Seleccion.Text

.SH = Val(Text5)

.SB = FormatCurrency(Val(Text6), 2)

.SN = FormatCurrency(Val(Text7), 2)

End With

Put W, R, Nomina

Close #W

Text1 = Val(Text1) + 1

Text2 = ""

Text3 = ""

Text4 = ""

Text5 = ""

Text6 = ""

Text7 = ""

Seleccion.Text = "Eliga Opción"

Text2.SetFocus

End If

End Sub

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

Line1.BorderColor = &H935511

Line2.BorderColor = &H935511

Line3.BorderColor = vbCyan

Line4.BorderColor = vbCyan

End Sub

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

Line1.Visible = True

Line2.Visible = True

Line3.Visible = True

Line4.Visible = True

End Sub

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

Line4.BorderColor = &H935511

Line3.BorderColor = &H935511

Line2.BorderColor = vbCyan

Line1.BorderColor = vbCyan

If MsgBox("¿Cerrar Esta Aplicacion?", vbQuestion + vbYesNo, "Saliendo Del Sitema") = vbYes Then

End

End If

End Sub

Private Sub Imprimir_Click()

Unload RegNomina

ImpNomina.Show

End Sub

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

Line6.BorderColor = &H935511

Line7.BorderColor = &H935511

Line5.BorderColor = vbCyan

Line8.BorderColor = vbCyan

End Sub

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

Line5.BorderColor = &H935511

Line8.BorderColor = &H935511

Line6.BorderColor = vbCyan

Line7.BorderColor = vbCyan

RegNomina.WindowState = 1

End Sub

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

Line8.Visible = True

Line7.Visible = True

Line6.Visible = True

Line5.Visible = True

End Sub

Private Sub Limpiar_Click()

Text1.SetFocus

Text1.SelStart = Len(Text1)

Text2 = ""

Text3 = ""

Text4 = ""

Text5 = ""

Text6 = ""

Text7 = ""

Seleccion.Text = "Eliga Opción"

End Sub

Private Sub Salir_Click()

End

End Sub

Private Sub Seleccion_Change()

Call Seleccion_Click

End Sub

Private Sub Seleccion_Click()

With Seleccion

If .ListIndex = 0 Then

Text5 = 20

ElseIf .ListIndex = 1 Then

Text5 = 80

ElseIf .ListIndex = 2 Then

Text5 = 250

End If

End With

End Sub

Private Sub Tiempo_Timer()

Cls

With RegNomina

Print Tab(1); "Hora : " & Time

Print Tab(1); "Fecha : " & FormatDateTime(Date, vbLongDate)

.ForeColor = vbWhite

.FontSize = 3

Print String(600, "`")

.ForeColor = &HF1BF87

.FontSize = 14

Print Tab(20); "UNIVERSIDAD DOMINICANA O & M"

.ForeColor = RGB(10, 225, 225)

.FontUnderline = True

Print Tab(32); "Nomina de Profesores"

.FrmeCuadro.Visible = True

.FontUnderline = False

.ForeColor = vbWhite

.FontSize = 3

Print String(600, "`")

Label3.Visible = True

Call Form_Activate

End With

End Sub

Menú de Word

Para ver el gráfico seleccione la opción "Descargar" del menú superior

Private Sub Atras_Click()

Form2.Hide

Form1.Show

End Sub

Private Sub Dirminuir_Click()

Text2.FontSize = Text2.FontSize – 4

End Sub

Private Sub fret_Click()

Text2.FontSize = Text2.FontSize + 4 + 1

End Sub

Nómina de empleado

Para ver el gráfico seleccione la opción "Descargar" del menú superior

Private Sub Command1_Click()

Dim SB, SN, TD, SS, SM, CLUB As Currency

SB = Val(Text3.Text)

SS = SB * 0.01

SM = SB * 0.05

CLUB = SB * 0.04

TD = SS + SM + CLUB

SN = SB – TD

Text4 = SN

End Sub

Private Sub Command2_Click()

Dim Nomina As Record

W = FreeFile

Open "A:Nomina.Txt" For Random As #W Len = 200

R = Val(Text1)

Nomina.Nombre = Text2

Nomina.SB = Val(Text3)

Nomina.SN = Val(Text4)

Put W, R, Nomina

Text1 = Val(Text1) + 1

Text2 = ""

Text3 = ""

Text2.SetFocus

End Sub

Private Sub Command3_Click()

Dim Nomina As Record

W = FreeFile

Open "A:Nomina.Txt" For Random As #W Len = 200

R = Val(Text1)

Get W, R, Nomina

With Nomina

Text2 = .Nombre

Text3 = .SB

Text4 = .SN

End With

End Sub

Private Sub Command4_Click()

Unload Form2

Form2.Show

End Sub

Private Sub Command5_Click()

If MsgBox("Desea Finalizar", vbQuestion + vbYesNo, "Saliendo de la Nomina de Pago") = vbYes Then

End

End If

MsgBox "Sigue buscando tu Sueldo"

End Sub

Private Sub Timer1_Timer()

Label3 = "Hora;" & Time

Label4 = "Fecha;" & Date

End Sub

Casimiro Antonio Castillo

Estudiante de Ing. Sistema 4to Semestre O&M