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