home *** CD-ROM | disk | FTP | other *** search
/ Prima Shareware 3 / DuCom_Prima-Shareware-3_cd1.bin / PROGRAMO / PASCAL / PASEX / PALETTE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-15  |  1.4 KB  |  64 lines
  1. { palette handling unit (C) 1995 by Paradise / Fate }
  2. { paradise@bachus.umcs.lublin.pl                    }
  3. unit palette;
  4. interface
  5.  
  6.  type
  7.   paltype = array [0..255,0..2] of byte;
  8.  var
  9.   stdpal  : paltype;
  10.  
  11.  procedure SetColor(number, r,g,b: byte);
  12.  procedure GetColor(number: byte; var r,g,b: byte);
  13.  procedure SetPalette(pal: paltype);
  14.  procedure GetPalette(var pal: paltype);
  15.  function  StepPalette(var p: paltype; pal: paltype): boolean;
  16.  
  17. implementation
  18.  
  19. procedure SetColor;
  20. begin
  21.  port[$3c8]:=number;
  22.  port[$3c9]:=r;
  23.  port[$3c9]:=g;
  24.  port[$3c9]:=b;
  25. end;
  26.  
  27. procedure GetColor;
  28. begin
  29.  port[$3c7]:=number;
  30.  r:=port[$3c9];
  31.  g:=port[$3c9];
  32.  b:=port[$3c9];
  33. end;
  34.  
  35. procedure SetPalette;
  36. var i: integer;
  37. begin
  38.  for i:=0 to 255 do SetColor(i,pal[i,0],pal[i,1],pal[i,2]);
  39. end;
  40.  
  41. procedure GetPalette;
  42. var i: integer;
  43. begin
  44.  for i:=0 to 255 do GetColor(i,pal[i,0],pal[i,1],pal[i,2]);
  45. end;
  46.  
  47. function StepPalette(var p: paltype; pal: paltype): boolean;
  48. var i: integer; b: boolean;
  49. begin
  50.  b:=false;
  51.  for i:=0 to 255 do
  52.  begin
  53.   if p[i,0]<pal[i,0] then begin inc(p[i,0]); b:=true; end;
  54.   if p[i,0]>pal[i,0] then begin dec(p[i,0]); b:=true; end;
  55.   if p[i,1]<pal[i,1] then begin inc(p[i,1]); b:=true; end;
  56.   if p[i,1]>pal[i,1] then begin dec(p[i,1]); b:=true; end;
  57.   if p[i,2]<pal[i,2] then begin inc(p[i,2]); b:=true; end;
  58.   if p[i,2]>pal[i,2] then begin dec(p[i,2]); b:=true; end;
  59.  end;
  60.  StepPalette:=b;
  61. end;
  62.  
  63. end.
  64.