Изменение цветовой палитры изображения

FiddleBitmap( MyBitmap, Fiddler ) ;

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;