home *** CD-ROM | disk | FTP | other *** search
- (* ************************************************************* *)
- (* 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.
-