home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / dos / prg / svgabg55 / svgautil.inc < prev    next >
Text File  |  1994-06-25  |  3KB  |  102 lines
  1. const
  2.   XNOR_PUT        = 5;
  3.   NOR_PUT        = 6;
  4.   NAND_PUT        = 7;
  5.   TRANS_COPY_PUT    = 8;    (* Doesn't work on 16-color systems *)
  6.  
  7. type DacPalette16  = array[0..15] of array[0..2] of Byte;
  8. type DacPalette256 = array[0..255] of array[0..2] of Byte;
  9.  
  10. (* Setvgapalette sets the entire 16 color palette *)
  11. (* PalBuf contains RGB values for all 16 colors   *)
  12. (* R,G,B values range from 0 to 63               *)
  13. procedure SetVGAPalette16(PalBuf : DacPalette16);
  14. var
  15.   Reg : Registers;
  16.  
  17. begin
  18.   reg.ax := $1012;
  19.   reg.bx := 0;
  20.   reg.cx := 16;
  21.   reg.es := Seg(PalBuf);
  22.   reg.dx := Ofs(PalBuf);
  23.   intr($10,reg);
  24. end;
  25.  
  26. (* Setvgapalette sets the entire 256 color palette *)
  27. (* PalBuf contains RGB values for all 256 colors   *)
  28. (* R,G,B values range from 0 to 63               *)
  29. procedure SetVGAPalette256(PalBuf : DacPalette256);
  30. var
  31.   Reg : Registers;
  32.  
  33. begin
  34.   reg.ax := $1012;
  35.   reg.bx := 0;
  36.   reg.cx := 256;
  37.   reg.es := Seg(PalBuf);
  38.   reg.dx := Ofs(PalBuf);
  39.   intr($10,reg);
  40. end;
  41.  
  42. function RGB(R,G,B : LongInt) : LongInt;
  43. var
  44.   MaxC : Longint;
  45. begin
  46.   MaxC := GetMaxColor;
  47.  
  48.   if (MaxC = 65535) then
  49.     RGB := (((R SHR 3) AND $1F) SHL 11) OR (((G SHR 2) AND $3F) SHL 5) OR
  50.         ((B SHR 3) AND $1F)
  51.   else if (MaxC = 32767) then
  52.     RGB := (((R SHR 3) AND $1F) SHL 10) OR (((G SHR 3) AND $1F) SHL 5) OR 
  53.         ((B SHR 3) and $1F)
  54.   else if (MaxC = 16777) then
  55.     RGB := ((R AND $FF) SHL 16) OR ((G AND $FF) SHL 8) OR (B AND $FF);
  56. end;
  57.  
  58. function RealDrawColor(Color : LongInt) : LongInt;
  59. var
  60.   MaxC : Longint;
  61. begin
  62.   MaxC := GetMaxColor;
  63.  
  64.   if (MaxC = 65535) then
  65.     SetRgbPalette(1024,(Color SHR 11) AND $1F,(Color SHR 5)AND $3F,Color AND $1F)
  66.   else if (MaxC = 32767) then
  67.     SetRgbPalette(1024,(Color SHR 10) AND $1F,(Color SHR 5)AND $1F,Color AND $1F)
  68.   else if (MaxC = 16777) then
  69.     SetRgbPalette(1024,(Color SHR 16) AND 255,(Color SHR 8)AND 255,Color AND 255);
  70.   RealDrawColor := Color;
  71. end;
  72.  
  73. function RealFillColor(Color : LongInt) : LongInt;
  74. var
  75.   MaxC : Longint;
  76. begin
  77.   MaxC := GetMaxColor;
  78.  
  79.   if (MaxC = 65535) then
  80.     SetRgbPalette(1025,(Color SHR 11) AND $1F,(Color SHR 5)AND $3F,Color AND $1F)
  81.   else if (MaxC = 32767) then
  82.     SetRgbPalette(1025,(Color SHR 10) AND $1F,(Color SHR 5)AND $1F,Color AND $1F)
  83.   else if (MaxC = 16777) then
  84.     SetRgbPalette(1025,(Color SHR 16) AND 255,(Color SHR 8)AND 255,Color AND 255);
  85.   RealFillColor := Color;
  86. end;
  87.  
  88. function RealColor(Color : LongInt) : LongInt;
  89. var
  90.   MaxC : Longint;
  91. begin
  92.   MaxC := GetMaxColor;
  93.  
  94.   if (MaxC = 65535) then
  95.     SetRgbPalette(1026,(Color SHR 11) AND $1F,(Color SHR 5)AND $3F,Color AND $1F)
  96.   else if (MaxC = 32767) then
  97.     SetRgbPalette(1026,(Color SHR 10) AND $1F,(Color SHR 5)AND $1F,Color AND $1F)
  98.   else if (MaxC = 16777) then
  99.     SetRgbPalette(1026,(Color SHR 16) AND 255,(Color SHR 8)AND 255,Color AND 255);
  100.   RealColor := Color;
  101. end;
  102.