uses crt;       {Pouzivam delay, clrscr a readkey}

      type Color = record          {typ pro ulozeni RGB}
                      R, G, B : byte;
                   end;

      var
         Citac, Barva, R, G, B : byte;
         Zaloha : array [0..255] of Color;    {Ulozeni palety}

      Procedure NactiPal (var Pole : array of Color);  {Ulozi paletu}
      var
         Citac : byte;
      begin
         Port[3C7] := 0;               {Zacinam barvou cislo 0}
         for Citac := 0 to 255 do       {Tolik je barev v palete}
         begin
             Pole[Citac].R := Port[3C9];
             Pole[Citac].G := Port[3C9];
             Pole[Citac].B := Port[3C9];
         end;
      end;

      Procedure ObnovPal (var Pole : array of Color);   {obnovi paletu}
      var
         Citac : byte;
      begin
         Port[3C8] := 0;               {Zacinam barvou cislo 0}
         for Citac := 0 to 255 do       {Tolik je barev v palete}
         begin
             Port[3C9] := Pole[Citac].R;
             Port[3C9] := Pole[Citac].G;
             Port[3C9] := Pole[Citac].B;
         end;
      end;


      procedure VezmiBarvu (Barva : byte);  {Nacte zadanou barvu z palety}
      begin
         Port[3c7] := Barva;
         R := Port[3c9];
         G := Port[3c9];
         B := Port[3c9];
      end;

      procedure UlozBarvu (Barva : byte);
      {Ulozi RGB do zadane barvy palety}
      begin
         Port[3c8] := Barva;
         Port[3c9] := R;
         Port[3c9] := G;
         Port[3c9] := B;
      end;

      procedure Smeti;       {Zaplni obrazovku barevnymi pismeny}
      var X, Y : byte;
      begin
         for X := 1 to 80 do      {80 sloupcu}
             for Y := 1 to 24 do  {24 radku, pri zapisu na 25. radek by}
                                  {obrazovka poskocila nahoru.}
             begin
                 GotoXY (X,Y);
                 TextColor (Random (255));      {Nahodna barva popredi}
                 TextBackground (Random (255));  {Nahodna barva pozadi}
                 write ('@');
             end;
      end;

      begin
         clrscr;
         Smeti;                {Nasypu na obrazovku barevne zavinace}
         NactiPal (Zaloha);        {Nejdrive uchovam puvodni paletu}
         For Citac := 1 to 63 do        {RGB jsou 0-63}
         begin
             For Barva := 0 to 255 do    {Barev je 0-255}
             begin
                 Vezmibarvu (Barva);      {Nactu barvu}
                 if R > 1 then dec (R);   {Ztlumim vsechny jeji slozky}
                 if G > 1 then dec (G);
                 if B > 1 then dec (B);
                 UlozBarvu (Barva);       {Ulozim ji zpatky}
             end;
             delay (20);   {Cely proces trosku zpomalim (386SX - 33MHz)}
         end;
         readkey;                {Obrazovka zhasnuta, cekam na klavesu}
         ObnovPal (Zaloha); {Obnovim puvodni paletu, aby bylo neco videt}
      end.


            výheň