program dcrpr01;
uses crt;
var
acuta,acutp,acura,acurp,acupa,acupp,acuca,acucp:real;
nf,nt,nr,np,nc:integer;
salid:boolean;
opcion,rk:char;
procedure triangulo;
var
pt,atr,mp,mpm,l1,l2,l3:real;
begin
clrscr;
writeln(' Tri ngulo'); writeln;
write('Escribe el valor de A:'); readln(l1);
writeln;
write('Escribe el valor de B:'); readln(l2);
writeln;
write('Escribe el valor de C:'); readln(l3);
if ((l1<=0) or (l2<=0) or (l3<=0)) then begin
writeln('Valor(es) no valido(s)'); write('Presione cualquier tecla para continuar'); rk:=readkey;
end
else begin
pt:=l1+l2+l3;
mp:=pt/2;
mpm:=(mp*(mp-l1)*(mp-l2)*(mp-l3));
if mpm<=0 then begin
writeln('Valor(es) no valido(s), no corresponden a un tri ngulo'); write('Presione cualquier tecla para continuar'); rk:=readkey;
end
else begin
atr:=sqrt(mpm);
nf:=nf+1;
nt:=nt+1;
writeln('-------------------------------------------------------------------------------'); write('No de figura procesada:tri ngulo '); write('Per¡metro=',pt:4:2,'m '); writeln('Superficie=',atr:4:2,'m2'); acuta:=acuta+atr;
acutp:=acutp+pt;
write('Presione cualquier tecla para continuar'); rk:=readkey;
end;
end;
end;
procedure rectangulo;
var
pr,ar,br,hr:real;
begin
clrscr;
writeln(' Rect ngulo'); writeln;
write('Escribe el valor de la base:'); readln(br);
writeln;
write('Escribe el valor de la altura:'); readln(hr);
if ((hr<=0) or (br<=0)) then begin
writeln('Valor(es) no valido(s)'); write('Presione cualquier tecla para continuar'); rk:=readkey;
end
else begin
ar:=br*hr;
pr:=2*(br+hr);
nf:=nf+1;
nr:=nr+1;
writeln('-------------------------------------------------------------------------------'); write('No de figura procesada:rect ngulo '); write('Per¡metro=',pr:4:2,'m '); writeln('Superficie=',ar:4:2,'m2'); acura:=acura+ar;
acurp:=acurp+pr;
write('Presione cualquier tecla para continuar'); rk:=readkey;
end;
end;
procedure pentagono;
var
pp,ap,ll:real;
begin
clrscr;
writeln(' Pent gono'); writeln;
write('Escribe la longitud del lado:'); readln(ll);
if (ll<=0) then begin
writeln('Valor(es) no valido(s)'); write('Presione cualquier tecla para continuar'); rk:=readkey;
end
else begin
pp:=ll*5;
ap:=(((5)*(ll*ll))/4)*((cos(pi/5))/(sin(pi/5)));
nf:=nf+1;
np:=np+1;
writeln('-------------------------------------------------------------------------------'); write('No de figura procesada:pent gono '); write('Per¡metro=',pp:4:2,'m '); writeln('Superficie=',ap:4:2,'m2'); acupa:=acupa+ap;
acupp:=acupp+pp;
write('Presione cualquier tecla para continuar'); rk:=readkey;
end;
end;
procedure circulo;
var
pc,ac,radio:real;
begin
clrscr;
writeln(' C¡rculo'); writeln;
write('Escribe la longitud del radio:'); readln(radio);
if (radio<=0) then begin
writeln('Valor(es) no valido(s)'); write('Presione cualquier tecla para continuar'); rk:=readkey;
end
else begin
pc:=pi*(radio*2);
ac:=pi*(radio*radio);
nf:=nf+1;
nc:=nc+1;
writeln('-------------------------------------------------------------------------------'); write('No de figura procesada:c¡rculo '); write('Per¡metro:',pc:4:2,' m '); writeln('Superficie:',ac:4:2,' m2'); acuca:=acuca+ac;
acucp:=acucp+pc;
write('Presione cualquier tecla para continuar'); rk:=readkey;
end;
end;
procedure salida;
var
raa,rap:real;
procedure lineas;
begin
writeln('-------------------------------------------------------------------------------'); end;
begin
clrscr;
writeln(' Resultados'); lineas;
writeln('Figura | procesados | subper¡metros | subsuperficies'); lineas;
writeln('Tri ngulos ',nt:2,' ',acutp:4:2,' ',acuta:4:2); writeln('Rect ngulos ',nr:2,' ',acurp:4:2,' ',acura:4:2); writeln('Pent gonos ',np:2,' ',acupp:4:2,' ',acupa:4:2); writeln('C¡rculos ',nc:2,' ',acucp:4:2,' ',acuca:4:2); lineas;
raa:=acuta+acura+acupa+acuca;
rap:=acutp+acurp+acupp+acucp;
writeln('Totales ',nf:2,' ',rap:4:2,' ',raa:4:2); salid:=false;
write('Presione cualquier tecla para continuar'); rk:=readkey;
clrscr;
end;
procedure menu;
begin
clrscr;
writeln('FIGURAS'); writeln('Autor:Rom n Dzul Calvillo'); writeln;
writeln('T:Tri ngulo'); writeln('R:Rect ngulo'); writeln('P:Pent gono'); writeln('C:C¡rculo'); writeln('S:Salir'); writeln;
write('Pulse una opci¢n:'); repeat
opcion:=readkey;
if opcion=#0 then
opcion:=readkey;
opcion:=upcase(opcion);
until opcion in ['T','R','P','C','S'];
end;
begin
clrscr;
nf:=0;
nt:=0;
nr:=0;
np:=0;
nc:=0;
acuta:=0;
acutp:=0;
acura:=0;
acurp:=0;
acupa:=0;
acupp:=0;
acuca:=0;
acucp:=0;
salid:=true;
repeat
menu;
case opcion of
'T':triangulo;
'R':rectangulo;
'P':pentagono;
'C':circulo;
'S':salida;
end;
until (salid=false);
end.
Crear cuenta
Comentarios sobre la versión: Versión 1 (1)