(* ************************************************************* *)
(* demo3.pas For Turbo Pascal - Demonstrates how to set palettes *)
(*                                                               *)
(*                                                               *)
(* Use the RM to create palette tables.                          *)
(*                                                               *)
(* NOTE: The BGI setrgbpalette function does not work properly.  *)
(*       Use the setrgb function that is provided here.          *)
(* ************************************************************* *)

Program Demo3;
   uses dos,crt,graph;


{$F+}
Function DetectVGA256 : integer;
begin
    DetectVGA256:=0;
end;
{$F-}

Procedure setVGA256;
Var
 gd,gm : Integer;
begin
 gd:=InstallUserDriver('svga256',@detectvga256);
 gd:=Detect;
 Initgraph(gd,gm,'');
end;

Procedure setvga16;
var
 gd,gm : integer;
begin
 gd:=VGA;
 gm:=VGAHI;

 initgraph(gd, gm, '');
end;

Procedure SetRGB(c, r, g, b : integer);
var
  reg : registers;
begin
if ((getmaxcolor=15) AND (c<16)) then
begin
 reg.ah := $10;
 reg.al := 0;
 reg.bl := c;
 reg.bh := c;
 intr($10,reg);
end;
 reg.ah := $10;
 reg.al := $10;
 reg.bx := c;
 reg.dh := r;
 reg.ch := g;
 reg.cl := b;
 intr($10,reg);
end;

Procedure SetNewPalette;
Const
(* Pascal Palette Source, 16 Colors (RGB)  *)

Pal : Array[1..48] of Byte = (
          $00,$00,$00,$3F,$15,$15,$3F,$18,$18,$3F,$1B,$1B,
          $3F,$1E,$1E,$3F,$21,$21,$3F,$24,$24,$3F,$27,$27,
          $3F,$2A,$2A,$3F,$2D,$2D,$3F,$30,$30,$3F,$33,$33,
          $3F,$36,$36,$3F,$39,$39,$3F,$3C,$3C,$3F,$3F,$3F);
var
 i : integer;
begin
 For i:=0 to 15 do
 begin
  setrgb(i,Pal[i*3+1],Pal[i*3+2],Pal[i*3+3]);
 end;
end;

Procedure DrawBars;
var
 i : integer;
 barwidth,barheight : integer;
 numcolors : integer;
begin
 numcolors:=getmaxcolor+1;
 barwidth:=getmaxx DIV numcolors;
 barheight:=getmaxy DIV 2;

 for i:=0 to numcolors do
 begin
   setfillstyle(Solidfill,i);
   bar(i*barwidth,0,i*barwidth+barwidth,barheight);
 end;
end;

Procedure WaitForKey;
var
 ch : char;
begin
 repeat until keypressed;
 ch:=readkey;
end;

begin
  setvga16;          (* replace with setvga256 for 256 color palettes *)

  drawbars;
  waitforkey;
  setnewpalette;
  setcolor(15);
  outtextxy(getmaxx div 2-50,getmaxy div 2+50,'NEW PALETTE');

  waitforkey;
  closegraph;
end.
