home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CMPLTPAS.ZIP / SETASP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-09-02  |  3.4 KB  |  119 lines
  1. {--------------------------------------------------------------}
  2. {                           AspectRatio                        }
  3. {                                                              }
  4. {         Aspect ratio adjustment demonstration program        }
  5. {                                                              }
  6. {                             by Jeff Duntemann                }
  7. {                             Turbo Pascal V5.0                }
  8. {                             Last update 9/3/88               }
  9. {                                                              }
  10. {     From: COMPLETE TURBO PASCAL 5.0  by Jeff Duntemann       }
  11. {    Scott, Foresman & Co., Inc. 1988   ISBN 0-673-38355-5     }
  12. {--------------------------------------------------------------}
  13.  
  14. PROGRAM AspectRatio;
  15.  
  16. USES Crt,Graph;
  17.  
  18. VAR
  19.   I,Color     : Integer;
  20.   Palette     : PaletteType;
  21.   GraphDriver : Integer;
  22.   GraphMode   : Integer;
  23.   ErrorCode   : Integer;
  24.  
  25.  
  26. {$I SQUARE.SRC}      { Described in Section 22.3 }
  27.  
  28.  
  29. PROCEDURE AdjustAspectRatio;
  30.  
  31. VAR Side   : Integer;
  32.     W      : Word;
  33.     Ch     : Char;
  34.     Quit   : Boolean;
  35.     Delta  : Integer;
  36.     Color  : Word;
  37.     Filler : FillSettingsType;
  38.     TheLine         : String;
  39.     XAspect,YAspect : Word;
  40.  
  41.  
  42. PROCEDURE ShowRatio;
  43.  
  44. VAR
  45.   Temp : String;
  46.  
  47. BEGIN
  48.   SetFillStyle(0,0); Bar(0,0,GetMaxX,20);
  49.   WITH Filler DO SetFillStyle(Pattern,Color);
  50.   GetAspectRatio(XAspect,YAspect);
  51.   TheLine := 'Current ratio: ';
  52.   Str(XAspect:6,Temp);
  53.   TheLine := TheLine + Temp + '/';
  54.   Str(YAspect:6,Temp);
  55.   TheLine := TheLine + Temp + '  Arrows to adjust; Q quits...';
  56.   OutTextXY(10,10,TheLine)
  57. END;
  58.  
  59.  
  60. BEGIN
  61.   Quit := False; Side := 180;
  62.   Color := GetColor; GetFillSettings(Filler);
  63.   GetAspectRatio(XAspect,YAspect);
  64.   Delta := YAspect DIV 100;
  65.   Square((GetMaxX DIV 2)-(Side DIV 2),
  66.          (GetMaxY DIV 2)-(Side DIV 2),Side,True);
  67.  
  68.   ShowRatio;
  69.   REPEAT
  70.     Ch := ReadKey;
  71.     IF Ch <> #0 THEN
  72.       IF Ch in ['Q','q'] THEN Quit := True ELSE Quit := False
  73.     ELSE
  74.       BEGIN
  75.         Ch := ReadKey;
  76.         CASE Ord(Ch) OF
  77.           $48 : BEGIN
  78.                  SetColor(0);
  79.                  Square((GetMaxX DIV 2)-(Side DIV 2),
  80.                         (GetMaxY DIV 2)-(Side DIV 2),Side,True);
  81.                  {Kluge fix:} W := YAspect+Delta;
  82.                  SetAspectRatio(XAspect,W);
  83.                  SetColor(Color);
  84.                  Square((GetMaxX DIV 2)-(Side DIV 2),
  85.                         (GetMaxY DIV 2)-(Side DIV 2),Side,True);
  86.                  ShowRatio;
  87.                END;
  88.           $50 : BEGIN
  89.                  SetColor(0);
  90.                  Square((GetMaxX DIV 2)-(Side DIV 2),
  91.                         (GetMaxY DIV 2)-(Side DIV 2),Side,True);
  92.                  {Kluge fix:} W := YAspect-Delta;
  93.                  SetAspectRatio(XAspect,W);
  94.                  SetColor(Color);
  95.                  Square((GetMaxX DIV 2)-(Side DIV 2),
  96.                         (GetMaxY DIV 2)-(Side DIV 2),Side,True);
  97.                  ShowRatio;
  98.                END;
  99.         END; { CASE }
  100.       END
  101.   UNTIL Quit
  102. END;
  103.  
  104.  
  105. BEGIN
  106.   GraphDriver := Detect;  { Let the BGI determine what board we're using }
  107.   DetectGraph(GraphDriver,GraphMode);
  108.   InitGraph(GraphDriver,GraphMode,'');
  109.   IF GraphResult <> 0 THEN
  110.     BEGIN
  111.       Writeln('>>Halted on graphics error: ',GraphErrorMsg(GraphResult));
  112.       Halt(2)
  113.     END;
  114.  
  115.   AdjustAspectRatio;
  116.  
  117.   CloseGraph;
  118. END.
  119.