home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 07 / tricks / patsdemo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-03-22  |  1.5 KB  |  60 lines

  1. (* ------------------------------------------------------ *)
  2. (*                  PATSDEMO.PAS                          *)
  3. (*        (c) 1989  D.Nashed   &   TOOLBOX                *)
  4. (* ------------------------------------------------------ *)
  5. PROGRAM PatsDemo;
  6.  
  7. USES Crt, Graph, Pats;
  8.  
  9. CONST  xmax = 719;   xfenster = 8;
  10.        ymax = 347;   yfenster = 8;
  11.  
  12. VAR    xf, yf : INTEGER;
  13.  
  14. PROCEDURE Main;
  15. VAR x, y : INTEGER;  faktor : REAL;
  16.  
  17.   PROCEDURE FensterAusgeben(xbasis, ybasis, hell : INTEGER);
  18.   BEGIN
  19.     Line(xbasis+00, ybasis+00, xbasis+xf, ybasis+00);
  20.     Line(xbasis+xf, ybasis+00, xbasis+xf, ybasis+yf);
  21.     Line(xbasis+xf, ybasis+yf, xbasis+00, ybasis+yf);
  22.     Line(xbasis+00, ybasis+yf, xbasis+00, ybasis+00);
  23.     SetFillPattern(pat [hell], 1);
  24.     FloodFill(xbasis+1, ybasis+1, 1);
  25.   END;
  26.  
  27. BEGIN
  28.   xf     := xmax DIV xfenster;
  29.   yf     := ymax DIV yfenster;
  30.   faktor := (xfenster * yfenster - 1) / 64;
  31.   FOR x := 0 TO xfenster - 1 DO
  32.     FOR y := 0 TO yfenster - 1 DO
  33.       FensterAusgeben(x*xf, y*yf,
  34.                       Trunc((x*yfenster + y)/faktor));
  35. END;
  36.  
  37. PROCEDURE Init;
  38. VAR det, modus, x, y, t : INTEGER;
  39. BEGIN
  40.   ClrScr;
  41.   DetectGraph(det, modus);
  42.   IF det <> 7 THEN BEGIN
  43.     WriteLn('Hercules card required');
  44.     Halt;
  45.   END;
  46.   det := detect;
  47.   modus := 0;
  48.   InitGraph(det, modus, '');
  49.   IF GraphResult <> grOk THEN Halt;
  50. END;
  51.  
  52. BEGIN
  53.   Init;
  54.   Main;
  55.   ReadLn;
  56.   CloseGraph;
  57. END.
  58. (* ------------------------------------------------------ *)
  59. (*               Ende von PATSDEMO.PAS                    *)
  60.