home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / HTMIX20.ZIP / VGACOLS.ZIP / COLORS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-14  |  3.0 KB  |  134 lines
  1. unit Colors;
  2. {┌──────────────────────────────────────────────────────────────────────────┐}
  3. {│ File    : COLORS.PAS                                                     │}
  4. {│ Author  : Harald Thunem                                                  │}
  5. {│ Purpose : VGA color palette routines                                     │}
  6. {│ Updated : July 13 1992                                                   │}
  7. {└──────────────────────────────────────────────────────────────────────────┘}
  8. interface
  9.  
  10. const CList    : array[0..15] of byte = ($00,$01,$02,$03,$04,$05,$14,$07,
  11.                                          $38,$39,$3A,$3B,$3C,$3D,$3E,$3F);
  12.  
  13.  
  14. type  TColor   = record
  15.                    R,G,B : byte;
  16.                  end;
  17.  
  18.  
  19. var   ColorList: array[0..15] of TColor;
  20.  
  21.  
  22. procedure GetTEXTPalette(PaletteReg: byte;  var ColorNum: byte);
  23. procedure SetTEXTPalette(PaletteReg,ColorNum: byte);
  24. procedure GetDACRegister(ColorNum: byte;  var RedValue,GreenValue,BlueValue: byte);
  25. procedure SetDACRegister(ColorNum,RedValue,GreenValue,BlueValue: byte);
  26. procedure GetColorList;
  27. procedure SetColorList;
  28. function ReadDACFile(Filename: string): boolean;
  29. procedure WriteDACFile(Filename: string);
  30.  
  31. implementation
  32.  
  33.  
  34. uses Dos;
  35.  
  36. var   Regs : registers;
  37.       CFile: file of TColor;
  38.  
  39.  
  40. procedure GetTEXTPalette(PaletteReg: byte;  var ColorNum: byte);
  41. begin
  42.   FillChar(Regs,SizeOf(Regs),$00);
  43.   Regs.AH := $10;
  44.   Regs.AL := $07;
  45.   Regs.BL := PaletteReg;
  46.   Intr($10,Regs);
  47.   ColorNum := Regs.BH;
  48. end;
  49.  
  50.  
  51. procedure SetTEXTPalette(PaletteReg,ColorNum: byte);
  52. begin
  53.   FillChar(Regs,SizeOf(Regs),$00);
  54.   Regs.AH := $10;
  55.   Regs.AL := $00;
  56.   Regs.BL := PaletteReg;
  57.   Regs.BH := ColorNum;
  58.   Intr($10,Regs);
  59. end;
  60.  
  61.  
  62. procedure GetDACRegister(ColorNum: byte;  var RedValue,GreenValue,BlueValue: byte);
  63. begin
  64.   FillChar(Regs,SizeOf(Regs),$00);
  65.   Regs.AH := $10;
  66.   Regs.AL := $15;
  67.   Regs.BX := ColorNum;
  68.   Intr($10,Regs);
  69.   RedValue   := Regs.DH;
  70.   GreenValue := Regs.CH;
  71.   BlueValue  := Regs.CL;
  72. end;
  73.  
  74.  
  75. procedure SetDACRegister(ColorNum,RedValue,GreenValue,BlueValue: byte);
  76. begin
  77.   FillChar(Regs,SizeOf(Regs),$00);
  78.   Regs.AH := $10;
  79.   Regs.AL := $10;
  80.   Regs.BX := ColorNum;
  81.   Regs.DH := RedValue;
  82.   Regs.CH := GreenValue;
  83.   Regs.CL := BlueValue;
  84.   Intr($10,Regs);
  85. end;
  86.  
  87.  
  88. procedure GetColorList;
  89. var i: byte;
  90. begin
  91.   for i := 0 to 15 do
  92.   with ColorList[i] do
  93.     GetDACRegister(CList[i],R,G,B);
  94. end;
  95.  
  96.  
  97. procedure SetColorList;
  98. var i: byte;
  99. begin
  100.   for i := 0 to 15 do
  101.   with ColorList[i] do
  102.     SetDACRegister(CList[i],R,G,B);
  103. end;
  104.  
  105.  
  106. function ReadDACFile(Filename: string): boolean;
  107. var i: byte;
  108. begin
  109.   {$I-}
  110.   Assign(CFile,Filename);
  111.   ReSet(CFile);
  112.   {$I+}
  113.   if IOResult=0 then
  114.   begin
  115.     for i := 0 to 15 do
  116.       Read(CFile,ColorList[i]);
  117.     Close(CFile);
  118.     ReadDACFile := true;
  119.   end
  120.   else ReadDACFile := false;
  121. end;
  122.  
  123.  
  124. procedure WriteDACFile(Filename: string);
  125. var i: byte;
  126. begin
  127.   Assign(CFile,Filename);
  128.   ReWrite(CFile);
  129.   for i := 0 to 15 do
  130.     Write(CFile,ColorList[i]);
  131.   Close(CFile);
  132. end;
  133.  
  134. end.