home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 10 / titel / mcgademo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-09-06  |  2.6 KB  |  123 lines
  1. (*                      MCGADEMO.PAS                   *)
  2. (*        (C) 1989 TOOLBOX & Jan Laitenberger          *)
  3. (*      Das Programm demonstriert die Anwendung        *)
  4. (*       der MCGA-UNIT in Turbo Pascal 4.0/5.x         *)
  5.  
  6. program MCGADEMO;
  7.  
  8.  
  9. uses crt, MCGA;
  10.  
  11. VAR x, y, color, rot, gruen, blau : INTEGER;
  12.     c : CHAR;
  13.     regbuf : ColorRegBuffer;
  14.     i : LONGINT;
  15.  
  16. begin
  17.   initgraphic;
  18.   clearscreen (203);
  19.   for x:=16 to 160 do
  20.     box (x,x,319-x,199-x,x);
  21.   x := 16; y := 1;
  22.   repeat
  23.     inc (x,y);
  24.     if (x =16) or (x = 31) then y := -y;
  25.     setcursor (10,12);
  26.     print (' MCGA = 256 Farben ',x);
  27.     delay (20);
  28.   until keypressed;
  29.   c := readkey;
  30.  
  31.   color := 1;
  32.   FOR y := 0 TO 199 DIV 5 DO BEGIN
  33.     line(0,100,319,y*5,color);
  34.     INC(color);
  35.   END;
  36.  
  37.   FOR y := 0 TO 199 DIV 5 DO BEGIN
  38.     line(0,y*5,319,100,color);
  39.     INC(color);
  40.   END;
  41.  
  42.   Delay(2000);
  43.  
  44.   mcgasave('test2.scr');
  45.   clearscreen(255);
  46.   Delay(2000);
  47.   mcgaload('test2.scr');
  48.   Delay(2000);
  49.  
  50.   colorbox(0,190,319,199,150);
  51.   (* Eine Farbe variieren *)
  52.   c := #0;
  53.   i := 0;
  54.   WHILE (i < 262144) AND (c = #0) DO BEGIN
  55.     INC(i);
  56.     readcolor(150,rot,gruen,blau);
  57.     INC(blau);
  58.     IF blau > 63 THEN BEGIN
  59.       blau := 0;
  60.       INC(gruen);
  61.       IF gruen > 63  THEN BEGIN
  62.         gruen := 0;
  63.         INC(rot);
  64.         IF rot > 63 THEN BEGIN
  65.           rot := 0;
  66.         END;
  67.       END;
  68.     END;
  69.     setcolor(150,rot,gruen,blau);
  70.     IF KeyPressed THEN BEGIN c := ReadKey; END;
  71.   END;
  72.  
  73.   clearscreen (255);
  74.   FOR x := 16 TO 160 DO BEGIN
  75.     box(x,x,319-x,199-x,x);
  76.   END;
  77.  
  78.  
  79.   (* Alle Farben "cyclen" *)
  80.   rot := 0;
  81.   gruen := 0;
  82.   blau := 0;
  83.   FOR color := 0 TO 255 DO BEGIN
  84.     regbuf[color].b := BYTE(blau);
  85.     regbuf[color].g := BYTE(gruen);
  86.     regbuf[color].r := BYTE(rot);
  87.     INC(blau,15);
  88.     IF blau > 63 THEN BEGIN
  89.       blau := 0;
  90.       INC(gruen,15);
  91.       IF gruen > 63 THEN BEGIN
  92.         gruen := 0;
  93.         INC(rot,15);
  94.         IF rot > 63 THEN BEGIN
  95.           rot := 0;
  96.         END;
  97.       END;
  98.     END;
  99.   END;
  100.  
  101.   setcolorblock(0,regbuf,256);
  102.  
  103.   WHILE NOT KeyPressed DO BEGIN
  104.     FOR color := 0 TO 255 DO BEGIN
  105.       INC(regbuf[color].b,15);
  106.       IF regbuf[color].b > 63 THEN BEGIN
  107.         regbuf[color].b := 0;
  108.         INC(regbuf[color].g,15);
  109.         IF regbuf[color].g > 63 THEN BEGIN
  110.           regbuf[color].g := 0;
  111.           INC(regbuf[color].r,15);
  112.           IF regbuf[color].r > 63 THEN BEGIN
  113.             regbuf[color].r := 0;
  114.           END;
  115.         END;
  116.       END;
  117.     END;
  118.     setcolorblock(0,regbuf,256);
  119.   END;
  120.  
  121.   exitgraphic;
  122. end.
  123.