Uses
Crt;
Var
Opc:char;
msg:string='Programa creado por Miguel Angel Huerta Granja';
Procedure Centrar(Texto:String; fila:Integer);
Var
Columna:integer;
Begin
Columna:=(80-Length(Texto)) DIV 2;
Gotoxy(Columna,fila);
Write(Texto);
End;
Procedure salida;
Begin
Clrscr;
Textbackground(red);
Textcolor(yellow);
Centrar('Pregrama para el calculo de areas se despide, BYEPIS',8);
Delay(2000);
End;
Procedure circulo;
Var
area,r:real;
Begin
Clrscr;
Centrar('Escribe el valor de r (radio)',5);
Readln(r);
area:=PI*r*r;
Centrar('El area del circulo es igual a',8);
Writeln(area:4:2);
Writeln;
Writeln;
Writeln;
Centrar('Presiona una tecla para regresar al menu',10);
Readkey;
End;
Procedure Triangulo;
Var
area,base,altura:real;
Begin
Clrscr;
Centrar('Escribe el valor de b (base)',5);
Readln(base);
Centrar('Escribe el valor de h (altura)',7);
Readln(altura);
area:=((base*altura)/2);
Centrar('El area del triangulo es igual a',9);
Writeln(area:4:2);
Writeln;
Writeln;
Writeln;
Centrar('Presiona una tecla para regresar al menu',10);
Readkey;
End;
Procedure Rectangulo;
Var
area,base,altura:real;
Begin
Clrscr;
Centrar('Escribe el valor de b (base)',5);
Readln(base);
Centrar('Escribe el valor de h (altura)',7);
Readln(altura);
area:=(base*altura);
Centrar('El area del rectangulo es igual a',9);
Writeln(area:4:2);
Writeln;
Writeln;
Writeln;
Centrar('Presiona cualquier tecla para regresar al menu',10);
Readkey;
End;
Procedure Cuadrado;
Var
area,Lado:real;
Begin
Clrscr;
Centrar('Escribe el valor del l (lado)',5);
Read(Lado);
area:=Lado*Lado;
Centrar('El area del Cuadrado es igual a: ',8);
Writeln(area:4:2);
Writeln;
Writeln;
Writeln;
Centrar('Presiona cualquier tecla para regresar al menu',10);
Readkey;
End;
Procedure Romboide;
Var
base,altura,area:real;
Begin
Clrscr;
Centrar('Escribe el valor de la b (base)',3);
Read(base);
Centrar('Escribe el valor de la a (altura)',5);
Read(altura);
area:=base*altura;
Centrar('El area del Romboide es igual a: ',8);
Writeln(area:4:2);
Writeln;
Writeln;
Writeln;
Centrar('Presiona cualquier tecla para regresar al menu',10);
Readkey;
End;
Procedure Trapecio;
Var
area,Basemayor,basemenor,altura:real;
Begin
Clrscr;
Centrar('Escribe el valor de la B (Basemayor)',5);
Read(Basemayor);
Centrar('Escribe el valor de la b (basemenor)',7);
Read(basemenor);
area:=Basemayor*basemenor/2;
Centrar('El area del Trapecio es igual a: ',9);
Writeln(area:4:2);
Writeln;
Writeln;
Writeln;
Centrar('Presiona cualquier tecla para regresar al menu',10);
Readkey;
End;
Procedure Pentagono;
Var
area,Perimetro,apotema:real;
Begin
Clrscr;
Centrar('Escribe el valor del P (Perimetro)',5);
Read(Perimetro);
Centrar('Escribe el valor de la a (apotema)',7);
Read(apotema);
area:=Perimetro*apotema/2;
Centrar('El area del Pentagono es igual a: ',9);
Writeln(area:4:2);
Writeln;
Writeln;
Writeln;
Centrar('Presiona ENTER para regresar al menu principal ',10);
Readkey;
End;
Procedure Rombo;
Var
area,Diagonalmayor,diagonalmenor:real;
Begin
Clrscr;
Centrar('Escribe el valor de la D (Diagonalmayor)',5);
Read(Diagonalmayor);
Centrar('Escribe el valor de la d (diagonalmenor)',7);
Read(diagonalmenor);
area:=Diagonalmayor*diagonalmenor/2;
Centrar('El area del Rombo es igual a: ',9);
Writeln(area:4:2);
Writeln;
Writeln;
Writeln;
Centrar('Presiona cualquier tecla para regresar al menu',10);
Readkey;
End;
Procedure suma;
var
x,y,z:integer;
begin
clrscr;
centrar('dame un numero:' ,5);
read(x);
centrar('dame otro numero: ',6);
read(y);
centrar('la suma de esos numeros es igual a: ',7);
z:=x+y;
writeln(z);
writeln;
writeln;
writeln;
centrar('presiona ENTER para regresar al menu principal',10);
readkey;
end;
Procedure resta;
var
x,y,z:integer;
begin
clrscr;
centrar('dame un numero:' ,5);
read(x);
centrar('dame otro numero: ',6);
read(y);
centrar('la resta de esos numeros es igual a: ',7);
z:=x-y;
writeln(z);
writeln;
writeln;
writeln;
centrar('presiona ENTER para regresar al menu principal',10);
readkey;
end;
Procedure multiplicacion;
var
x,y,z:integer;
begin
clrscr;
centrar('dame un numero:' ,5);
read(x);
centrar('dame otro numero: ',6);
read(y);
centrar('la multiplicacion de esos numeros es igual a: ',7);
z:=x*y;
writeln(z);
writeln;
writeln;
writeln;
centrar('presiona ENTER para regresar al menu principal',10);
readkey;
end;
Procedure Numeracion1;
Var
x:integer;
Begin
Clrscr;
For x:=1 to 100 do
Begin
Write(' ',x);
End;
Readkey;
End;
Procedure Numeracion2;
Var
x:integer;
Begin
Clrscr;
For x:=100 downto 1 do
Begin
Write(' ',x);
End;
Readkey;
End;
Procedure Numeracion3;
Var
x,y:integer;
Begin
Clrscr;
y:=0;
For x:=0 to 100 do
Begin
Write(' ',y);
y:=y+2;
End;
Readkey;
End;
Procedure Numeracion4;
Var
x,y:integer;
Begin
Clrscr;
y:=1;
For x:=1 to 100 do
Begin
Write(' ',y);
y:=y+2;
End;
Readkey;
End;
Procedure numeraciones;
begin
Repeat
Clrscr;
Gotoxy(18,1);
Writeln('+-------------------------------------------+');
Gotoxy(18,2);
Writeln('| |');
Gotoxy(18,3);
Writeln('+-------------------------------------------+');
Gotoxy(23,2);
Textcolor(yellow);
textbackground(red);
Writeln(msg);
Textcolor(white);
Textbackground(black);
Gotoxy(16,5);
Writeln('+---------------------------------------------------+');
Gotoxy(16,6);
Writeln('| |');
Gotoxy(16,7);
Writeln('| |');
Gotoxy(16,8);
Writeln('| |');
Gotoxy(16,9);
Writeln('| |');
Gotoxy(16,10);
Writeln('| |');
Gotoxy(16,11);
Writeln('| |');
Gotoxy(16,12);
Writeln('| |');
Gotoxy(16,13);
Writeln('| |');
Gotoxy(16,14);
Writeln('| |');
Gotoxy(16,15);
Writeln('| |');
Gotoxy(16,16);
Writeln('| |');
Gotoxy(16,17);
Writeln('| |');
Gotoxy(16,18);
Writeln('| |');
Gotoxy(16,19);
Writeln('+---------------------------------------------------+');
Centrar('OPCIONES DEL PROGRAMA',6);
Centrar('[N]umeracion de menor a mayor',8);
Centrar('N[u]meracion de mayor a menor',10);
Centrar('Nu[M]eracion de dos en dos',12);
Centrar('Num[E]racion de tres en tres',14);
Centrar('[Y] Regresar al programa principal',16);
Textcolor(green);
Centrar('Elige una opcion',18);
Opc:=readkey;
Case opc of
'N','n': Numeracion1;
'U','u': Numeracion2;
'M','m': Numeracion3;
'E','e': Numeracion4;
End;
Until (opc='Y') or (opc='y');
End;
Procedure aritmeticas;
begin
repeat
clrscr;
gotoxy(18,1);
writeln('+---------------------------------------+');
gotoxy(18,2);
writeln('| |');
gotoxy(18,3);
writeln('+---------------------------------------+');
gotoxy(23,2);
textcolor(yellow);
textbackground(red);
writeln(msg);
textcolor(white);
textbackground(black);
gotoxy(16,5);
writeln('+--------------------------------------------------------------+');
gotoxy(16,6);
writeln('| |');
gotoxy(16,7);
writeln('| |');
gotoxy(16,8);
writeln('| |');
gotoxy(16,9);
writeln('| |');
gotoxy(16,10);
writeln('| |');
gotoxy(16,11);
writeln('| |');
gotoxy(16,12);
writeln('| |');
gotoxy(16,13);
writeln('| |');
gotoxy(16,14);
writeln('| |');
gotoxy(16,15);
writeln('| |');
gotoxy(16,16);
writeln('| |');
gotoxy(16,17);
writeln('| |');
gotoxy(16,18);
writeln('| |');
gotoxy(16,19);
writeln('+--------------------------------------------------------------+');
centrar('OPCIONES DEL PROGRAMA',6);
centrar('[S]umar dos numeros',8);
centrar('[R]estar dos numeros',10);
centrar('[M]ultiplicar dos numeros',12);
Centrar('[Y] Regresar al programa principal',14);
textcolor(green);
centrar('elige una opcion',16);
opc:=readkey;
case opc of
'S','s': suma;
'R','r': resta;
'M','m': multiplicacion;
End;
Until(opc='Y') or (opc='y');
End;
Procedure areas;
Begin
Repeat;
Clrscr;
Gotoxy(18,1);
Writeln('+--------------------------------------------+');
Gotoxy(18,2);
Writeln('| |');
Gotoxy(18,3);
Writeln('+--------------------------------------------+');
Gotoxy(23,2);
Textcolor(yellow);
Textbackground(black);
Writeln(msg);
Textcolor(white);
Textbackground(black);
Gotoxy(16,5);
Writeln('+---------------------------------------------------+');
Gotoxy(16,6);
Writeln('| |');
Gotoxy(16,7);
Writeln('| |');
Gotoxy(16,8);
Writeln('| |');
Gotoxy(16,9);
Writeln('| |');
Gotoxy(16,10);
Writeln('| |');
Gotoxy(16,11);
Writeln('| |');
Gotoxy(16,12);
Writeln('| |');
Gotoxy(16,13);
Writeln('| |');
Gotoxy(16,14);
Writeln('| |');
Gotoxy(16,15);
Writeln('| |');
Gotoxy(16,16);
Writeln('| |');
Gotoxy(16,17);
Writeln('| |');
Gotoxy(16,18);
Writeln('| |');
Gotoxy(16,19);
Writeln('+---------------------------------------------------+');
Centrar('Opciones del programa',6);
Centrar('[C]irculo',8);
Centrar('[T]riangulo',9);
Centrar('[R]ectagulo',10);
Centrar('C[U]adrado',11);
Centrar('R[O]mboide',12);
Centrar('Tr[A]pecio',13);
Centrar('[P]entagono',14);
Centrar('Ro[M]bo',15);
Centrar('[Y] Regresar al programa principal',17);
Textcolor(green);
Centrar('Elige una opcion',20);
opc:=readkey;
Case opc of
'C','c':circulo;
'T','t':triangulo;
'R','r':rectangulo;
'U','u':cuadrado;
'O','o':romboide;
'A','a':trapecio;
'P','p':pentagono;
'M','m':rombo;
End;
Until(opc='Y') or (opc='y');
End;
Begin
Repeat
Clrscr;
Textcolor(Green);
Centrar('Programa integrador tercer parcial',6);
Centrar('Elaborado por: Edgar Marquez Aponte',7);
Centrar('Bachillerato 30',8);
Centrar('Quinto A',9);
Centrar('Programacion |',10);
Textcolor(yellow);
Centrar('Presiona ENTER para continuar',14);
Textcolor(White);
Readkey;
Clrscr;
Gotoxy(18,1);
Writeln('+-------------------------------------------+');
Gotoxy(18,2);
Writeln('| |');
Gotoxy(18,3);
Writeln('+-------------------------------------------+');
Gotoxy(23,2);
Textcolor(yellow);
Textbackground(black);
Writeln(msg);
Textcolor(white);
Textbackground(black);
Gotoxy(16,5);
Writeln('+---------------------------------------------------+');
Gotoxy(16,6);
Writeln('| |');
Gotoxy(16,7);
Writeln('| |');
Gotoxy(16,8);
Writeln('| |');
Gotoxy(16,9);
Writeln('| |');
Gotoxy(16,10);
Writeln('| |');
Gotoxy(16,11);
Writeln('| |');
Gotoxy(16,12);
Writeln('| |');
Gotoxy(16,13);
Writeln('| |');
Gotoxy(16,14);
Writeln('| |');
Gotoxy(16,15);
Writeln('| |');
Gotoxy(16,16);
Writeln('| |');
Gotoxy(16,17);
Writeln('| |');
Gotoxy(16,18);
Writeln('| |');
Gotoxy(16,19);
Writeln('+---------------------------------------------------+');
Centrar('Opciones del programa',6);
Centrar('[O]peraciones aritmeticas',8);
Centrar('[C]alculo de areas',9);
Centrar('C[I]clos',10);
Centrar('[X] Salir del programa',17);
Textcolor(green);
Centrar('Elige una opcion',20);
opc:=readkey;
Case opc of
'O','o':aritmeticas;
'C','c':areas;
'I','i':numeraciones;
'X','x':salida;
End;
Until(opc='X') or (opc='x');
End.
No hay comentarios:
Publicar un comentario