home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / h / htmix20.zip / VGACOLS.ZIP / VGADEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1992-07-14  |  2KB  |  131 lines
  1. program VGADemo;
  2.  
  3. uses Crt,
  4.      Screen,
  5.      Keyboard,
  6.      Colors;
  7.  
  8. var  List: array[0..15] of TColor;
  9.  
  10.  
  11. procedure SetReds;
  12. var i: byte;
  13. begin
  14.   for i := 7 downto 1 do
  15.   begin
  16.     List[i].R := 3+8*i;
  17.     List[i].G := 0;
  18.     List[i].B := 0;
  19.     with List[i] do
  20.       SetDACRegister(CList[i],R,G,B);
  21.     List[7+i].R := 8*(8-i)-1;
  22.     List[7+i].G := 0;
  23.     List[7+i].B := 0;
  24.     with List[7+i] do
  25.       SetDACRegister(CList[7+i],R,G,B);
  26.   end;
  27. end;
  28.  
  29.  
  30. procedure SetGreens;
  31. var i: byte;
  32. begin
  33.   for i := 7 downto 1 do
  34.   begin
  35.     List[i].R := 0;
  36.     List[i].G := 3+8*i;
  37.     List[i].B := 0;
  38.     with List[i] do
  39.       SetDACRegister(CList[i],R,G,B);
  40.     List[7+i].R := 0;
  41.     List[7+i].G := 8*(8-i)-1;
  42.     List[7+i].B := 0;
  43.     with List[7+i] do
  44.       SetDACRegister(CList[7+i],R,G,B);
  45.   end;
  46. end;
  47.  
  48.  
  49. procedure SetBlues;
  50. var i: byte;
  51. begin
  52.   for i := 7 downto 1 do
  53.   begin
  54.     List[i].R := 0;
  55.     List[i].G := 0;
  56.     List[i].B := 3+8*i;
  57.     with List[i] do
  58.       SetDACRegister(CList[i],R,G,B);
  59.     List[7+i].R := 0;
  60.     List[7+i].G := 0;
  61.     List[7+i].B := 8*(8-i)-1;
  62.     with List[7+i] do
  63.       SetDACRegister(CList[7+i],R,G,B);
  64.   end;
  65. end;
  66.  
  67.  
  68. procedure SetWhite;
  69. var i: byte;
  70. begin
  71.   for i := 7 downto 1 do
  72.   begin
  73.     List[i].R := 3+8*i;
  74.     List[i].G := 3+8*i;
  75.     List[i].B := 3+8*i;
  76.     with List[i] do
  77.       SetDACRegister(CList[i],R,G,B);
  78.     List[7+i].R := 8*(8-i)-1;
  79.     List[7+i].G := 8*(8-i)-1;
  80.     List[7+i].B := 8*(8-i)-1;
  81.     with List[7+i] do
  82.       SetDACRegister(CList[7+i],R,G,B);
  83.   end;
  84. end;
  85.  
  86.  
  87. procedure VaryColors;
  88. var i,j: byte;
  89.     t: TColor;
  90. begin
  91.   Key := NullKey;
  92.   j := 1;
  93.   SetReds;
  94.   repeat
  95.     t := List[1];
  96.     for i := 1 to 13 do
  97.       List[i] := List[i+1];
  98.     List[14] := t;
  99.     for i := 14 downto 1 do
  100.     with List[i] do
  101.       SetDACRegister(CList[i],R,G,B);
  102.     if KeyPressed then
  103.     begin
  104.       InKey(Ch,Key);
  105.       Inc(j);
  106.       if j>4 then j:=1;
  107.       case j of
  108.         1: SetReds;
  109.         2: SetGreens;
  110.         3: SetBlues;
  111.         4: SetWhite;
  112.       end;
  113.     end;
  114.   until Key=Escape;
  115. end;
  116.  
  117.  
  118. begin
  119.   GetColorList;
  120.   if not LoadScreenFromFile('VGADEMO.SCR') then
  121.     Halt(1);
  122.   SetIntens;
  123.   SetCursor(CursorOff);
  124.   VaryColors;
  125.   Fill(25,1,1,80,White+BlackBG,' ');
  126.   GoToRC(24,1);
  127.   SetCursor(CursorUnderline);
  128.   SetColorList;
  129.   SetBlink;
  130. end.
  131.