martes, 12 de diciembre de 2006

Cuadrado triangulo rombo en pascal

Programa que genera un cuadrado, triángulo y rombo de la siguiente forma,
del tamaño especificado:

program CuaTriRom (input, output);

const
ESPACIO = ' ';
ASTERISCO = '*';

var
opcUsuario: char;
finPrograma: boolean value false;

procedure Cuadrado;
var fila, j,tam: integer;
despl: integer;
carExt: char value ASTERISCO;
carInt: char value ESPACIO;
opcRelleno: char;

begin
repeat
write('Lleno o vací­o (l,v) ');
readln(opcRelleno);
until (opcRelleno = 'l') or (opcRelleno = 'v');
if opcRelleno= 'l' then carInt:= ASTERISCO;

writeln('Escribe el tamaño del cuadrado: ');
readln(tam);

despl := 40 - tam div 2;

for fila:= 1 to tam do begin
write('':despl);
for j:= 1 to tam do
if (j=1) or (j=tam) or (fila=1) or (fila=tam) then
write (carExt)
else write (carInt);
writeln;
end;
end;

procedure Triangulo;

var fila, j,tam: integer;
despl: integer;
carExt: char value ASTERISCO;
carInt: char value ESPACIO;
numColum: integer value 1; { Cantidad de columnas que se escriben }
opcRelleno: char;

begin
repeat
write('Lleno o vacío (l,v) ');
readln(opcRelleno);
until (opcRelleno = 'l') or (opcRelleno = 'v');

writeln('Escribe el tamaño del triangulo: ');
readln(tam);

if (opcRelleno = 'l') then carInt:= ASTERISCO;

for fila:=1 to tam do begin
despl := 40 - tam - numColum div 2; { Posición en la pantalla }
write('':despl);
for j:=1 to numColum do begin
if (fila=1) or (fila=tam) or (j=1) or (j = numColum) then
write (carExt)
else write (carInt);
end;
writeln;
numColum:= numColum +2;
end;
end;

procedure Rombo;
var
fila, j: integer;
despl: integer;
carExt: char value ASTERISCO;
carInt: char value ESPACIO;
numColum: integer value 1; { Cantidad de columnas que se escriben }
tam,mitad: integer;
opcRelleno:char;

begin
repeat
write('Lleno o vací­o (l,v) ');
readln(opcRelleno);
until (opcRelleno = 'l') or (opcRelleno = 'v');
if opcRelleno= 'l' then carInt:= ASTERISCO;

repeat
writeln('Escribe un valor impar entre 11 y 15');
readln(tam);
until ( (tam mod 2 <> 0) and (tam >= 11) and (tam <= 15) );

mitad:= tam div 2 +1;

for fila:=1 to tam do begin
despl := 40 - tam - numColum div 2; { Posición en la pantalla }
write('':despl);

if(fila < mitad) then begin { Parte superior del rombo }
for j:=1 to numColum do begin
if (fila=1) or (fila=tam) or (j=1) or (j=numColum) then
write (carExt)
else write (carInt);
end;
writeln;
numColum:= numColum +2;
end
else
begin { Parte inferior del rombo }

for j:=numColum downto 1 do begin
if (fila=1) or (fila=tam) or (j=1) or (j=numColum) then
write (carExt)
else write (carInt);
end;
writeln;
numColum:= numColum -2;
end
end;
end;



begin
repeat
writeln('c Cuadrado');
writeln('t Triangulo');
writeln('r Rombo');
writeln('s Salir');
write('Intoduce una opción: ');
readln(opcUsuario);
case opcUsuario of
'c', 'C': Cuadrado;
't', 'T': Triangulo;
'r', 'R': Rombo;
's', 'S': finPrograma:=true;
otherwise finPrograma:=false;
end;
until (finPrograma);
end.

1 comentario:

Anónimo dijo...

hola soy luciano de entre rios argentina soy tecnico electromecanico y aspirante a ingeniero.
recivi conseptos de programacion con lenguaje basic y tambien con el PLC logo 0.b.a.3. utilizando el lenguaje LADDER y SISTEMA DE BLOQUES para programarlo.
Me gustaria aprender conseptos y forma de programar con el lenguaje pascal si me podrian ayudar dejo mi correo electronico: luchylandia@hotmail.com
les doy muchas gracias