Código Factorial De Un Número

EL FACTORIAL DE UN NÚMERO
Este programa permite calcular el factorial de un numero, para ello debemos ingresar un valor . Solo utilizamos un modulo (Mmain).

MODULO MMain
PUBLIC SUB Main()
DIM f, i, l AS Integer
DIM nombre, res AS String
PRINT "<<<>>>"
PRINT "Ingrese un valor"
INPUT l
f = 1
FOR i = 2 TO l
f = f * i
NEXT
PRINT "El factorial del numero ingresado es !", f
END

Código Operaciones Basicas

OPERACIONES
En este programa utilizamos un formulario con 4 label, 3 TextBox, 6 Button, calcula las operaciones básicas, suma, resta, multiplicación, y división.

PUBLIC SUB Button1_Click()
TextBox3.Text = TextBox1.Text + TextBox2.Text
TextBox1.SetFocus
END
PUBLIC SUB Button3_Click()
ME.Close
END
PUBLIC SUB Button2_Click()
TextBox1.Clear
TextBox2.Clear
TextBox3.Clear
TextBox1.SetFocus
END
PUBLIC SUB TextBox1_KeyPress()
TextBox2.SetFocus
END
PUBLIC SUB Button5_Click()
TextBox3.Text = TextBox1.Text - TextBox2.Text
TextBox1.SetFocus
END
PUBLIC SUB Button4_Click()
TextBox3.Text = TextBox1.Text * TextBox2.Text
TextBox1.SetFocus
END
PUBLIC SUB Button6_Click()
TextBox3.Text = TextBox1.Text / TextBox2.Text
TextBox1.SetFocus
END

Código Productos

PRODUCTOS
En este programa calculamos el total de quintales, y el porcentaje de cada uno, para ello ingresamos cantidad de café, cacao, maíz. Solo utilizamos un modulo (MMain)

MODULO Mmain

PUBLIC SUB Main()
DIM A, B, C, S, PC, PC1, PM AS Integer
PRINT "<>>"
PRINT "Ingrese cantidad de cafe"
INPUT A
PRINT "Ingrese cantidad de cacao"
INPUT B
PRINT "Ingrese cantidad de maiz"
INPUT C
PRINT "El total de cafe es...", A
PRINT "El total de cacao es...", B
PRINT "El total de maiz es...", C
S = A + B + C
PRINT "El total de quintales es...", S
PRINT "EL PORCENTAJE DE CADA PRODUCTO ES"
PC = (S * A) / 100
PC1 = (S * B) / 100
PM = (S * C) / 100
PRINT "El porcentaje de cafe es...%", PC
PRINT "El porcentaje de cacao es...%", PC1
PRINT "El porcentaje de maiz es...%", PM
END

Código Promedio

PROMEDIO
Este programa calcula la suma, el promedio, la equivalencia en letras, y el resultado si aprueba o no la materia. Con tres notas, segun la siguiente tabla 10 sobresaliente,9-8 muy buena,7 buena, 6-1 insuficiente.
Para esto utilizamos dos modulos el principal (MMain) y otro Module1.

MODULO Mmain
PUBLIC SUB Main()
DIM cal1, cal2, cal3 AS Integer
PRINT "INGRESE NOTA 1:..."
INPUT cal1
PRINT " INGRESE NOTA 2:..."
INPUT cal2
PRINT " INGRESE NOTA 3:..."
INPUT cal3
PRINT "<<<>>>", Module1.SUM(cal1, cal2, cal3)
PRINT "<<<>>>", Module1.PROM(cal1, cal2, cal3)
PRINT "<<<>>>", Module1.EQUIVAL(cal1, cal2, cal3)
PRINT "RESULTADO", Module1.RESULTADO(cal1, cal2, cal3)
END
MODULE 1
PUBLIC FUNCTION SUM(p1 AS Integer, p2 AS Integer, p3 AS Integer) AS Integer
DIM s AS Integer
s = p1 + p2 + p3
RETURN s
END
PUBLIC FUNCTION PROM(p1 AS Integer, p2 AS Integer, p3 AS Integer) AS Integer
DIM prom AS Integer
prom = (p1 + p2 + p3) DIV 3
RETURN prom
END
PUBLIC FUNCTION EQUIVAL(p1 AS Integer, p2 AS Integer, p3 AS Integer) AS String
DIM equi AS Integer
DIM e AS String
equi = (p1 + p2 + p3) DIV 3
IF (equi <>
e = "insuificiente"
ELSE IF (equi = 7) THEN
e = "bueno"
ELSE IF (equi <>
e = "muy bueno"
ELSE
e = "sobresaliente"
END IF
RETURN e
END
PUBLIC FUNCTION RESULTADO(p1 AS Integer, p2 AS Integer, p3 AS Integer) AS String
DIM equi AS Integer
DIM e AS String
equi = (p1 + p2 + p3) DIV 3
IF (equi <>
e = "REPRUEBA"
ELSE IF (equi <>
e = "RECUPERACION"
ELSE
e = "APRUEBA"
END IF
RETURN e
END

Formulario Usuarios TIA

usuario
tiene 4 Label, 5 Button, 3 TextBox, 1GridView.

PUBLIC f AS Integer
PUBLIC au AS Integer
PUBLIC SUB Button2_Click()
IF TextBox3 = "" AND TextBox1 = "" AND TextBox2 = "" THEN
Message.Info("Ingrese datos...")
limpiar()
TextBox3.SetFocus
ELSE
TRY modulo.cn.Exec("insert into clave values( '" & Trim(TextBox3.Text) & "','" & Trim(TextBox1.Text) & "', '" & Trim(TextBox2.Text) & "') ")
IF ERROR THEN
Message.Error("Imposible Ingresar el usuario...")
ELSE
Message.Info("Usuario Ingresado...")
au = au + 1
' deshabilt()
ENDIF
modulo.rs = modulo.cn.Exec("select * from clave")
mostrar()
'limpiar()
deshabilt()
'ELSE
'Message.Info("Debe ingresar datos...")
ENDIF
END
PUBLIC SUB limpiar()
TextBox1.Clear
TextBox2.Clear
TextBox3.Clear
END
PUBLIC SUB mostrar()
modulo.rs.MoveFirst
IF modulo.rs.Count > 0 THEN
Grid1.Columns.Count = 3
Grid1.Rows.Count = modulo.rs.Count + 1
Grid1.Columns[0].Width = 50
Grid1.Columns[1].Width = 250
Grid1.Columns[2].Width = 250
Grid1[0, 0].Text = "Idclave"
Grid1[0, 1].Text = "Usuario"
Grid1[0, 2].Text = "Password"
f = 1
modulo.rs.MoveFirst
DO WHILE modulo.rs.Available
Grid1[f, 0].Text = modulo.rs["idclave"]
Grid1[f, 1].Text = modulo.rs["usuario"]
Grid1[f, 2].Text = modulo.rs["contrasenia"]
f = f + 1
modulo.rs.MoveNext()
LOOP
ENDIF
END
PUBLIC SUB TextBox1_KeyPress()
IF Key.Code = 65293 THEN
IF TextBox1.Text = "" THEN
Message.Info("Ingrese Nombre de Usuario...")
TextBox1.SetFocus
ELSE
TextBox2.SetFocus
ENDIF
ENDIF
END
PUBLIC SUB TextBox2_KeyPress()
IF Key.Code = 65293 THEN
IF TextBox1.Text = "" THEN
Message.Info("Ingrese Clave de Usuario...")
TextBox1.SetFocus
ELSE
' habilit()
Button3.SetFocus
ENDIF
ENDIF
END
PUBLIC SUB deshabilt()
Button2.Enabled = FALSE
Button3.Enabled = FALSE
Button4.Enabled = FALSE
Button5.Enabled = FALSE
TextBox1.Enabled = FALSE
TextBox2.Enabled = FALSE
TextBox3.Enabled = FALSE
END
PUBLIC SUB habilit()
Button2.Enabled = TRUE
Button3.Enabled = TRUE
Button4.Enabled = TRUE
Button5.Enabled = TRUE
TextBox1.Enabled = TRUE
TextBox2.Enabled = TRUE
TextBox3.Enabled = TRUE
END
PUBLIC SUB Form_Open()
ME.Center
modulo.conectar
modulo.rs = modulo.cn.Exec("select * from clave")
mostrar()
'deshabilitar()
' deshabilt()
END
PUBLIC SUB Button1_Click()
' TextBox1.Clear
' TextBox2.Clear
limpiar()
habilit()
TextBox3.setfocus
END
PUBLIC SUB Button4_Click()
SELECT Message.Question("Desea eliminar el Usuario", "Si", "No")
CASE 1
TRY Modulo.cn.Exec("Delete from clave where usuario='" & Trim(UCase(TextBox1.Text)) & "'")
IF ERROR THEN
Message.Error("Imposible de borrar el usuario")
ELSE
modulo.rs = Modulo.cn.Exec("select * from clave")
mostrar()
END IF
CASE 2
Message.Info("Usuario no eliminado")
CASE 3
END SELECT
limpiar()
TextBox3.SetFocus
END
PUBLIC SUB Button5_Click()
DIM ban AS Integer
Modulo.rs = Modulo.cn.Exec("select * from clave")
DO WHILE Modulo.rs.Available
IF modulo.rs["idclave"] = Trim(UCase(TextBox3.Text)) THEN
Modulo.rs = Modulo.cn.Exec("select * from clave where idclave = '" & Trim(UCase(TextBox3.Text)) & "'")
TextBox1.Text = Modulo.rs["usuario"]
TextBox2.Text = Modulo.rs["contrasenia"]
'ValueBox1.Value = Modulo.rs["cantidad"]
ban = 1
ENDIF
MODULO.rs.MoveNext()
LOOP
IF ban = 0 THEN
Message.Error("Registro Invalido")
limpiar()
END IF
END
PUBLIC SUB TextBox3_KeyPress()
IF Key.Code = 65293 THEN
IF TextBox3.Text = "" THEN
Message.Info("Ingrese Nombre de Usuario...")
TextBox3.SetFocus
ELSE
TextBox1.SetFocus
ENDIF
ENDIF
END
PUBLIC SUB menu_Click()
ME.Close
END
PUBLIC SUB Button3_Click()
TRY Modulo.cn.Exec("update clave set idclave='" & Trim(UCase(TextBox3.Text)) & "',usuario='" & Trim(UCase(TextBox1.Text)) & "',contrasenia='" & Trim(UCase(TextBox2.Text)) & "' where=textbox3.text ")
IF ERROR THEN
Message.Error("Imposible actualizar el registro")
ELSE
Message.Info("Registro actualizado")
END IF
mostrar()
'LIMPIAR
END

Gambas

menuprincipal

PUBLIC SUB inventario_Click()
FMain.Show
END
PUBLIC SUB salir_Click()
ME.Close
END
PUBLIC SUB usuarios_Click()
usuario.Show
END
PUBLIC SUB Form_Open()
ME.Center
modulo.conectar
END
protector
Este formulario tiene 1 DrawingArea, 1 Button, y un timer.

PUBLIC x AS Integer
PUBLIC y AS Integer
PUBLIC r AS Integer
PUBLIC g AS Integer
PUBLIC b AS Integer
PUBLIC SUB Button1_Click()
Timer1.Enabled = TRUE
END
PUBLIC SUB Timer1_Timer()
x = Int(Rnd * 800)
y = Int(Rnd * 600)
r = Int(Rnd * 255)
g = Int(Rnd * 255)
b = Int(Rnd * 255)
Draw.Begin(area1)
Draw.FillColor = Color.Red
Draw.FillColor = Color.RGB(r, g, b)
Draw.FillStyle = Fill.Solid
Draw.Circle(x, y, 80)
Draw.Circle(200, 200, 80)
Draw.Rect(100, 100, 100, 50)
Draw.End
END

Progamacion en Gambas

TIA

En este programa utilizamos un modulo (Modulo), y 5 formularios, acceso, inventario (Fmain), menuprincipal,protector, usuario, Y una base de datos con dos tablas, clave y producto.

Modulo
PUBLIC cn AS NEW connection
PUBLIC rs AS Result
PUBLIC SUB conectar()

'WITH Modulo.cn
cn.CLOSE
cn.type = "mysql"
cn.host = "localhost" ' 192.168.1.201
cn.login = "root"
cn.port = "3306"
cn.password = "root"
cn.name = "tia"
'evalua y devuelve errores
TRY cn.OPEN
IF ERROR THEN
Message("Error al abrir base de datos")
ELSE
Message("Ingresando a base de datos")
ENDIF

END
acceso
Tiene 3 Label , 2 textbox, y 2 button

PUBLIC c AS Integer
PUBLIC n AS String

PUBLIC SUB Form_Open()

ME.Center
modulo.conectar
' modulo.rs = modulo.cn.Exec("select * from clave")
n = "Administrador"

END

PUBLIC SUB Button1_Click()
DIM ban AS Integer
modulo.rs = modulo.cn.Exec("select * from clave")

DO WHILE modulo.rs.Available
n = modulo.rs["usuario"]
IF modulo.rs["usuario"] = Trim(TextBox2.Text) AND modulo.rs["contrasenia"] = Trim(TextBox1.Text) THEN
modulo.rs = modulo.cn.Exec("select * from clave where usuario = '" & Trim(TextBox1.Text) & "'")
Message.Info("Bienvenidos. " & n, "Aceptar")
ME.Hide
menuprincipal.Show
ban = 1
ENDIF
modulo.rs.MoveNext()
LOOP
IF ban = 0 THEN
c = c + 1
IF c = 3 THEN
Message.Warning("Error, El sistema debe cerrarse por seguridad.")
ME.Close
ELSE
limpiar()
TextBox1.SetFocus
Message.Error("Usuario no existe, intente de nuevo...", "Aceptar")
ENDIF
END IF

END
PUBLIC SUB limpiar()

Button1.Enabled = FALSE
Button2.Enabled = FALSE
TextBox1.Clear
TextBox2.Clear
TextBox2.Enabled = FALSE
TextBox1.SetFocus
END

INVENTARIO (Fmain)
Tiene 5 label, 3 texbox, 1 ValueBox, 6 button, 1 TabStrip, 1 GridView

PUBLIC con AS Integer
PUBLIC fil AS Integer
PUBLIC col AS Integer
PUBLIC SUB Form_Open()
Modulo.conectar
Modulo.rs = modulo.cn.Exec("select * from producto")
mostrar()
END

PUBLIC SUB Button6_Click()

ME.Close

END

PUBLIC SUB Button3_Click()

TRY Modulo.cn.Exec("insert into producto values('" & Trim(UCase(TextBox1.Text)) & "','" & Trim(UCase(TextBox2.Text)) & "','" & (TextBox3.Text) & "','" & (ValueBox1.Text) & "');")
IF ERROR THEN
Message.Error("Imposible presentar el registro")
ELSE
Message.Info("registro insertado")
ENDIF
Modulo.rs = Modulo.cn.Exec("Select * from producto")
mostrar()
desabilitar()
END
PUBLIC SUB desabilitar()
TextBox1.Enabled = FALSE
TextBox2.Enabled = FALSE
TextBox3.Enabled = FALSE
ValueBox1.Enabled = FALSE
END
PUBLIC SUB mostrar()
Modulo.rs.MoveFirst
IF Modulo.rs.count > 0 THEN
GridView1.columns.count = 4
GridView1.Rows.Count = Modulo.rs.count + 1
GridView1.columns[0].width = 60
GridView1.columns[1].width = 180
GridView1.columns[2].width = 80
GridView1.columns[3].width = 80
GridView1[0, 0].Text = "codigo"
GridView1[0, 1].Text = "nombre"
GridView1[0, 2].Text = "cantidad"
GridView1[0, 3].Text = "precio unitatrio"
fil = 1
Modulo.rs.MoveFirst
DO WHILE Modulo.rs.Available

GridView1[fil, 0].Text = Modulo.rs["codigo"]
GridView1[fil, 1].Text = Modulo.rs["nombre"]
GridView1[fil, 2].Text = Modulo.rs["cantidad"]
GridView1[fil, 3].Text = Modulo.rs["precio"]
fil = fil + 1
Modulo.rs.MoveNext()
LOOP
ENDIF

END


PUBLIC SUB Button4_Click()

SELECT Message.Question("Desea eliminar un Producto", "Si", "No")
CASE 1
TRY Modulo.cn.Exec("Delete from producto where codigo='" & Trim(UCase(TextBox1.Text)) & "'")
IF ERROR THEN
Message.Error("Imposible borrar el registro")
ELSE
modulo.rs = Modulo.cn.Exec("select * from producto")
mostrar()

END IF
CASE 2
Message.Info("Registro no eliminado")
CASE 3
END SELECT
limpiar()
TextBox1.SetFocus
END

PUBLIC SUB Button5_Click()

TRY Modulo.cn.Exec("update producto set nombre='" & Trim(UCase(TextBox2.Text)) & "',precio='" & Trim(UCase(TextBox3.Text)) & "',cantidad='" & Trim(UCase(ValueBox1.Text)) & "' where=textbox1.text ")
IF ERROR THEN
Message.Error("Imposible actualizar el registro")
ELSE
Message.Info("Registro actualizado")
END IF
mostrar
'LIMPIAR

END

PUBLIC SUB Button2_Click()

TextBox1.Clear
TextBox2.Clear
TextBox3.Clear
TextBox3.Text = 0
ValueBox1.Clear
abilitar()
TextBox1.SetFocus

END
PUBLIC SUB abilitar()
TextBox1.Enabled = TRUE
TextBox2.Enabled = TRUE
TextBox3.Enabled = TRUE
ValueBox1.Enabled = TRUE
END

PUBLIC SUB Button1_Click()

DIM ban AS Integer
Modulo.rs = Modulo.cn.Exec("select * from producto")
DO WHILE Modulo.rs.Available

IF modulo.rs["codigo"] = Trim(UCase(TextBox1.Text)) THEN
Modulo.rs = Modulo.cn.Exec("select * from producto where codigo = '" & Trim(UCase(TextBox1.Text)) & "'")
TextBox2.Text = Modulo.rs["nombre"]
TextBox3.Text = Modulo.rs["precio"]
ValueBox1.Value = Modulo.rs["cantidad"]
ban = 1
ENDIF
MODULO.rs.MoveNext()
LOOP
IF ban = 0 THEN
Message.Error("Registro Invalido")
limpiar()
END IF

END
PUBLIC SUB limpiar()

TextBox1.Clear
TextBox2.Clear
TextBox3.Clear
TextBox3.Text = 0
ValueBox1.Clear

END

PUBLIC SUB GridView1_DblClick()

IF GridView1.Current = NULL THEN RETURN
SELECT Message.Question("Desea eliminar un Producto", "Si", "No", "Ayuda")
CASE 1
TRY Modulo.cn.Exec("Delete from producto where codigo='" & Trim(UCase(GridView1.Current.Text)) & "'")
IF ERROR THEN
Message.Error("Imposible borrar el registro")
ELSE
Modulo.rs = Modulo.cn.Exec("select * from producto")
mostrar()

END IF
CASE 2
Message.Info("Registro no eliminado")
CASE 3
END SELECT
GridView1.Columns.Width = 100

END
PUBLIC SUB TextBox1_KeyPress()

IF Key.Code = 65293 THEN
IF TextBox1.Text = "" THEN
Message.Info("Ingrese codigo de producto")
TextBox1.SetFocus
ELSE
TextBox2.SetFocus
ENDIF
ENDIF
END

PUBLIC SUB TextBox2_KeyPress()

IF Key.Code = 65293 THEN
IF TextBox1.Text = "" THEN
Message.Info("Ingrese codigo de producto")
TextBox2.SetFocus
ELSE
TextBox3.SetFocus
ENDIF
ENDIF
END