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

Мне необходимо изменить цветовую палитру изображения с помощью SetBitmapBits, но у меня, к сожалению, ничего не получается.
Использование SetBitmapBits - не очень хорошая идея, поскольку она имеет дело с HBitmaps, в котором формат пикселя не определен. Несомненно, это более безопасная операция, но никаких гарантий по ее выполнению дать невозможно.
Взамен я предлагаю использовать функции DIB API. Вот некоторый код, позволяющий вам изменять таблицу цветов. Просто напишите метод с такими же параметрами, как у TFiddleProc и и изменяйте ColorTable, передаваемое как параметр. Затем просто вызовите процедуру FiddleBitmap, передающую TBitmap и ваш fiddle-метод, например так:
 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;
Source: Взято с http://delphiworld.narod.ru
ID: 03701
Category:Графика
Category:Цвета и палитры