Advertisement
paulogp

Rectangulo

Aug 7th, 2011
168
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 1.18 KB | None | 0 0
  1. { paulogp }
  2. Program Peda_01; {Desenha, usando asteriscos, um rectângulo.}
  3.  
  4. Uses
  5.     WinCrt;
  6.  
  7. Const
  8.     Max_Comp=79;
  9.     Max_Larg=22;
  10.  
  11. Var
  12.     Cont_A,Cont_B,Comp_Rect,Larg_Rect: Integer;
  13.     Tecla: Char;
  14.  
  15. Begin
  16.     Repeat
  17.         ClrScr;
  18.         WriteLn('Desenho de rectangulo!');
  19.         WriteLn('~~~~~~~~~~~~~~~~~~~~~~');
  20.         WriteLn('Programado por: Paulo G.P');
  21.         WriteLn;
  22.         Repeat
  23.             WriteLn;
  24.             Write('Comprimento do rectangulo: ');
  25.             ReadLn(Comp_Rect);
  26.             If Comp_Rect<=0 then WriteLn('O valor tem de ser maior que "0"!');
  27.             If Comp_Rect>Max_Comp then WriteLn('O valor tem de ser menor que "',Max_Comp,'"!');
  28.         Until (Comp_Rect>0) and (Comp_Rect<Max_Comp);
  29.         Repeat
  30.             WriteLn;
  31.             Write('Largura do rectangulo: ');
  32.             ReadLn(Larg_Rect);
  33.             If Larg_Rect<=0 then WriteLn('O valor tem de ser maior que "0"!');
  34.             If Larg_Rect>Max_Larg then WriteLn('O valor tem de ser menor que "',Max_Larg,'"!');
  35.         Until (Larg_Rect>0) and (Larg_Rect<Max_Larg);
  36.         WriteLn;
  37.         For Cont_A:=1 to Larg_Rect do
  38.         Begin
  39.             WriteLn;
  40.             For Cont_B:=1 to Comp_Rect do Write('*');
  41.         End;
  42.         WriteLn;
  43.         WriteLn;
  44.         Write('Repetir o programa (s/n)? ');
  45.         Tecla:=ReadKey;
  46.     Until (Tecla='N') or (Tecla='n');
  47.     DoneWinCrt;
  48. End.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement