Delphi 1

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

Мне необходимо изменить цветовую палитру изображения с помощью 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 ;

{ Следующая процедура на основе изображения создает 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 ;

finally

FreeMem( BitmapInfo, BitmapInfoSize ) ;

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 ;

- Mike Scott [000827]