type
 TFiddleProc = procedure(var ColorTable: TColorTable) of object;
const
 LogPaletteSize = sizeof(TLogPalette) + sizeof(TPaletteEntry) * 255;
function PaletteFromDIB(BitmapInfo: PBitmapInfo): HPalette;
var
 LogPalette: PLogPalette;
 i: integer;
 Temp: byte;
begin
 with BitmapInfo^, bmiHeader do
 begin
  GetMem(LogPalette, LogPaletteSize);
  try
  with LogPalette^ do
  begin
  palVersion := $300;
  palNumEntries := 256;
  Move(bmiColors, palPalEntry, sizeof(TRGBQuad) * 256);
  for i := 0 to 255 do
  with palPalEntry[i] do
  begin
  Temp := peBlue;
  peBlue := peRed;
  peRed := Temp;
  peFlags := PC_NOCOLLAPSE;
  end;
  { создаем палитру }
  Result := CreatePalette(LogPalette^);
  end;
  finally
  FreeMem(LogPalette, LogPaletteSize);
  end;
 end;
end;
{ Следующая процедура на основе изображения создает DIB,
изменяет ее таблицу цветов, создавая тем самым новую палитру,
после чего передает ее обратно изображению. При этом
используется метод косвенного вызова, с помощью которого
изменяется палитра цветов - ей передается array[ 0..255 ] of TRGBQuad. }
procedure FiddleBitmap(Bitmap: TBitmap; FiddleProc: TFiddleProc);
const
 BitmapInfoSize = sizeof(TBitmapInfo) + sizeof(TRGBQuad) * 255;
var
 BitmapInfo: PBitmapInfo;
 Pixels: pointer;
 InfoSize: integer;
 ADC: HDC;
 OldPalette: HPalette;
begin
 { получаем DIB }
 GetMem(BitmapInfo, BitmapInfoSize);
 try
  { меняем таблицу цветов - ПРИМЕЧАНИЕ: она использует 256 цветов DIB }
  FillChar(BitmapInfo^, BitmapInfoSize, 0);
  with BitmapInfo^.bmiHeader do
  begin
  biSize := sizeof(TBitmapInfoHeader);
  biWidth := Bitmap.Width;
  biHeight := Bitmap.Height;
  biPlanes := 1;
  biBitCount := 8;
  biCompression := BI_RGB;
  biClrUsed := 256;
  biClrImportant := 256;
  GetDIBSizes(Bitmap.Handle, InfoSize, biSizeImage);
  { распределяем место для пикселей }
  Pixels := GlobalAllocPtr(GMEM_MOVEABLE, biSizeImage);
  try
  { получаем пиксели DIB }
  ADC := GetDC(0);
  try
  OldPalette := SelectPalette(ADC, Bitmap.Palette, false);
  try
  RealizePalette(ADC);
  GetDIBits(ADC, Bitmap.Handle, 0, biHeight, Pixels, BitmapInfo^,
  DIB_RGB_COLORS);
  finally
  SelectPalette(ADC, OldPalette, true);
  end;
  finally
  ReleaseDC(0, ADC);
  end;
  { теперь изменяем таблицу цветов }
  FiddleProc(PColorTable(@BitmapInfo^.bmiColors)^);
  { создаем палитру на основе новой таблицы цветов }
  Bitmap.Palette := PaletteFromDIB(BitmapInfo);
  OldPalette := SelectPalette(Bitmap.Canvas.Handle, Bitmap.Palette,
  false);
  try
  RealizePalette(Bitmap.Canvas.Handle);
  StretchDIBits(Bitmap.Canvas.Handle, 0, 0, biWidth, biHeight, 0, 0,
  biWidth, biHeight,
  Pixels, BitmapInfo^, DIB_RGB_COLORS, SRCCOPY);
  finally
  SelectPalette(Bitmap.Canvas.Handle, OldPalette, true);
  end;
  finally
  GlobalFreePtr(Pixels);
  end;
  end;
 finally
  FreeMem(BitmapInfo, BitmapInfoSize);
 end;
end;
{ Пример "fiddle"-метода }
procedure TForm1.Fiddler(var ColorTable: TColorTable);
var
 i: integer;
begin
 for i := 0 to 255 do
  with ColorTable[i] do
  begin
  rgbRed := rgbRed * 9 div 10;
  rgbGreen := rgbGreen * 9 div 10;
  rgbBlue := rgbBlue * 9 div 10;
  end;
end;