home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / pascal / pascsrc.arc / SHAPES3.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-01-15  |  1.8 KB  |  73 lines
  1. program Calculate_Areas;
  2.  
  3. (*  This program is dedicated to Marsha, a student, who
  4.     was of tremendous help during the debugging stage of
  5.     the text and programs. Thanks Marsha!
  6. *)
  7.  
  8. var In_Char : char;
  9.  
  10. procedure Area_Of_Square;
  11. var Length,Area : real;
  12. begin
  13.    Write('Square   Enter length of side ');
  14.    Readln(Length);
  15.    Area := Length * Length;
  16.    Writeln('The area is ',Area:12:4);
  17. end;
  18.  
  19. procedure Area_Of_Rectangle;
  20. var Width,Height,Area : real;
  21. begin
  22.    Write('Rectangle   Enter width ');
  23.    Readln(Width);
  24.    Write('Enter height ');
  25.    Read(Height);
  26.    Area := Width * Height;
  27.    Writeln('    The area is ',Area:12:4);
  28. end;
  29.  
  30. procedure Area_Of_Triangle;
  31. var Base,Height,Area : real;
  32. begin
  33.    Write('Triangle     Enter base ');
  34.    Readln(Base);
  35.    Write('Enter height ');
  36.    Read(Height);
  37.    Area := 0.5 * Base * Height;
  38.    Writeln('    The area is ',Area:12:3);
  39. end;
  40.  
  41. procedure Area_Of_Circle;
  42. var Radius,Area : real;
  43. begin
  44.    Write('Circle    Enter radius ');
  45.    Readln(Radius);
  46.    Area := 3.141592 * Radius * Radius;
  47.    Writeln('The area is ',Area:12:3);
  48. end;
  49.  
  50. begin  (* main program *)
  51.    repeat
  52.       Writeln;
  53.       Writeln('Please input the first letter of the selection');
  54.       Writeln('Select shape; Square Rectangle Triangle Circle Quit');
  55.       Write('Requested shape is ');
  56.       Repeat until Keypressed;
  57.       Read(Kbd,In_Char);
  58.       case In_Char of
  59.        'S' : Area_Of_Square;
  60.        's' : Area_Of_Square;
  61.        'R' : Area_Of_Rectangle;
  62.        'r' : Area_Of_Rectangle;
  63.        'T' : Area_Of_Triangle;
  64.        't' : Area_Of_Triangle;
  65.        'C' : Area_Of_Circle;
  66.        'c' : Area_Of_Circle;
  67.        'Q' : Writeln('Quit');
  68.        'q' : Writeln('Quit');
  69.        else Writeln(' undefined entry');
  70.       end;
  71.    until (In_Char = 'Q') or (In_Char = 'q');
  72. end.  (* of main program *)
  73.