home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l045 / 1.ddi / SCRNPRNT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-12-23  |  2.8 KB  |  163 lines
  1.  
  2. {           Copyright (c) 1985, 87 by Borland International, Inc.            }
  3.  
  4. program ScreenIO;
  5.  
  6. {$I Float.inc}  { Determines what type Float means. }
  7.  
  8. uses
  9.   Dos, Crt, GDriver, GKernel;
  10.  
  11. procedure Sierpinski;
  12. const
  13.   N = 5;
  14. var
  15.   I, H, X, Y, X0, Y0 : integer;
  16.   Sec : boolean;
  17.  
  18. procedure Plot;                        { Draw a line }
  19. begin
  20.   DrawLine(X, Y, X0, Y0);
  21.   X0 := X;
  22.   Y0 := Y;
  23. end;
  24.  
  25. procedure B(I:integer); forward;       { Forward references for recursion }
  26.  
  27. procedure C(I:integer); forward;
  28.  
  29. procedure D(I:integer); forward;
  30.  
  31. procedure A(I : integer);              { First recursive procedure }
  32. begin
  33.   if I > 0 then
  34.   begin
  35.     A(I - 1);
  36.     X := X + H;
  37.     Y := Y - H;
  38.     Plot;
  39.     B(I - 1);
  40.     X := X + 2 * H;
  41.     Plot;
  42.     D(I - 1);
  43.     X := X + H;
  44.     Y := Y + H;
  45.     Plot;
  46.     A(I - 1);
  47.   end;
  48. end; { A }
  49.  
  50. procedure B;                           { Second recursive procedure }
  51. begin
  52.   if I > 0 then
  53.   begin
  54.     B(I - 1);
  55.     X := X - H;
  56.     Y := Y - H;
  57.     Plot;
  58.     C(I - 1);
  59.     Y := Y - 2 * H;
  60.     Plot;
  61.     A(I - 1);
  62.     X := X + H;
  63.     Y := Y - H;
  64.     Plot;
  65.     B(I - 1);
  66.   end;
  67. end; { B }
  68.  
  69. procedure C;                           { Third recursive procedure }
  70. begin
  71.   if I > 0 then
  72.   begin
  73.     C(I - 1);
  74.     X := X - H;
  75.     Y := Y + H;
  76.     Plot;
  77.     D(I - 1);
  78.     X := X - 2 * H;
  79.     Plot;
  80.     B(I - 1);
  81.     X := X - H;
  82.     Y := Y - H;
  83.     Plot;
  84.     C(I - 1);
  85.   end;
  86. end; { C }
  87.  
  88. procedure D;                           { Last recursive procedure }
  89. begin
  90.   if I > 0 then
  91.   begin
  92.     D(I - 1);
  93.     X := X + H;
  94.     Y := Y + H;
  95.     Plot;
  96.     A(I - 1);
  97.     Y := Y + 2 * H;
  98.     Plot;
  99.     C(I - 1);
  100.     X := X - H;
  101.     Y := Y + H;
  102.     Plot;
  103.     D(I - 1);
  104.   end;
  105. end; { D }
  106.  
  107. procedure DoIt;                        { Sierpinski main procedure }
  108. begin
  109.   I := 3;
  110.   H := 16;
  111.   X0 := 30;
  112.   Y0 := 240;
  113.   repeat
  114.     I := I + 1;
  115.     X0 := X0 - H;
  116.     H := H div 2;
  117.     Y0 := Y0 + H;
  118.     X := X0;
  119.     Y := Y0;
  120.     A(I - 1);
  121.     X := X + H;
  122.     Y := Y - H;
  123.     Plot;
  124.     B(I - 1);
  125.     X := X - H;
  126.     Y := Y - H;
  127.     Plot;
  128.     C(I - 1);
  129.     X := X - H;
  130.     Y := Y + H;
  131.     Plot;
  132.     D(I - 1);
  133.     X := X + H;
  134.     Y := Y + H;
  135.     Plot;
  136.   until I = N;
  137. end; { DoIt }
  138.  
  139. begin
  140.   SetHeaderOn;
  141.   DefineWorld(1, -3, -3, 258, 258);
  142.   SelectWorld(1);
  143.   SelectWindow(1);
  144.   DrawBorder;
  145.   DoIt;
  146. end; { Sierpinski }
  147.  
  148. begin
  149.   InitGraphic;                         { Initialize the graphics system }
  150.  
  151.   DefineHeader(1, 'DEMONSTRATE SCREEN PRINTING'); { Give it a header }
  152.  
  153.   SetHeaderOn;
  154.  
  155.   Sierpinski;                          { Do the curve }
  156.  
  157.   HardCopy(false, 1);                  { Print it }
  158.  
  159.   repeat until KeyPressed;             { Wait until a key is pressed }
  160.  
  161.   LeaveGraphic;                        { Leave the graphics system }
  162. end. { ScreenIO }
  163.