How can I access the palette of a TPicture.Graphic? - delphi

Question

I have searched the web for hours but I can not find anything about how to get the palette from a TPicture.Graphic. I also need to get the color values so I can pass these values to a TStringList for filling cells in a colorpicker.
Here is the code that I currently have:
procedure TFormMain.OpenImage1Click( Sender: TObject );
var
i: integer;
S: TStringList;
AColor: TColor;
AColorCount: integer;
N: string;
Pal: PLogPalette;
HPal: hPalette;
begin
if OpenPictureDialog1.Execute then
begin
Screen.Cursor := crHourGlass;
try
Pal := nil;
try
S := TStringList.Create;
ABitmap.Free; // Release any existing bitmap
ABitmap := TBitmap.Create;
Image1.Picture.LoadFromFile( OpenPictureDialog1.Filename );
ABitmap.Canvas.Draw( 0, 0, Image1.Picture.Graphic );
GetMem( Pal, Sizeof( TLogPalette ) + Sizeof( TPaletteEntry ) * 255 );
Pal.palversion := $300;
Pal.palnumentries := 256;
for i := 0 to 255 do
begin
AColor := Pal.PalPalEntry[ i ].PeRed shl 16 + Pal.PalPalEntry[ i ].PeGreen shl 8 + Pal.PalPalEntry[ i ].PeBlue;
N := ColorToString( AColor );
S.Add( N );
end;
HPal := CreatePalette( Pal^ );
ABitmap.Palette := HPal;
Memo1.Lines := S;
finally; FreeMem( Pal ); end;
S.Free;
finally; Screen.Cursor := crDefault; end;
end;
end;
I am drawing to the canvas of ABitmap with the image contained in Image1.Picture.Graphic because I want to support all TPicture image types such as Bitmap, Jpeg, PngImage, and GIfImg.
Any assistance would be appreciated. Am I on the correct path or is something different needed?

Answer 1

The code you posted does nothing really. You either have to read the palette back from the bitmap before you can access it, or you need to create a palette and assign it to a bitmap - your code does neither.
The following code is more or less yours, with fields fBitmap and fBitmapPalEntries for the results of the operation. I commented all the lines that I changed:
if OpenPictureDialog1.Execute then
begin
Screen.Cursor := crHourGlass;
try
Pal := nil;
try
S := TStringList.Create;
fBitmap.Free; // Release any existing bitmap
fBitmap := TBitmap.Create;
// if you want a 256 colour bitmap with a palette you need to say so
fBitmap.PixelFormat := pf8bit;
Image1.Picture.LoadFromFile( OpenPictureDialog1.Filename );
fBitmap.Canvas.Draw( 0, 0, Image1.Picture.Graphic );
// access the palette only if bitmap has indeed one
if fBitmap.Palette <> 0 then begin
GetMem( Pal, Sizeof( TLogPalette ) + Sizeof( TPaletteEntry ) * 255 );
Pal.palversion := $300;
Pal.palnumentries := 256;
// read palette data from bitmap
fBitmapPalEntries := GetPaletteEntries(fBitmap.Palette, 0, 256,
Pal.palPalEntry[0]);
for i := 0 to fBitmapPalEntries - 1 do
begin
AColor := Pal.PalPalEntry[ i ].PeRed shl 16
+ Pal.PalPalEntry[ i ].PeGreen shl 8
+ Pal.PalPalEntry[ i ].PeBlue;
N := ColorToString( AColor );
S.Add( N );
end;
// doesn't make sense, the palette is already there
// HPal := CreatePalette( Pal^ );
// fBitmap.Palette := HPal;
Memo1.Lines := S;
end;
finally; FreeMem( Pal ); end;
S.Free;
finally; Screen.Cursor := crDefault; end;
end;
Support for palettes with less entries is easy, you just need to reallocate the memory after you know how many entries there are, something like
ReallocMem(Pal, SizeOf(TLogPalette) + SizeOf(TPaletteEntry) * (fBitmapPalEntries - 1));
Creating a palette would only be necessary if you want to write a bitmap in pf4Bit or pf8Bit format. You would need to determine the 16 or 256 colours that are palette entries, possibly by reducing the number of colours (dithering). Then you would fill the palette colour slots with the colour values, and finally use the two lines I commented out from your code. You have to make sure that the pixel format of the bitmap and the number of palette entries match.

Answer 2

A wonderful resource of graphics alogithms is available at efg's reference library which includes a specific section dealing with just color. Specifically this article (with source) discusses counting the available colors and might be of the best use.

Answer 3

I don't know myself, but you might take a look at XN Resource Editor, which does display palette information, is written in Delphi and has source available.

Answer 4

Thank-you all.... especially mghie. We managed to get the code to work very well for bmp, png and gif files and pf1bit, pf4bit, pf8bit, pf16bit and pf24bit images. We are still tesing the code but so far it seems to work very well. Hopefully this code will help other developers as well.
var
i: integer;
fStringList: TStringList;
fColor: TColor;
fColorString: string;
fPal: PLogPalette;
fBitmapPalEntries: Cardinal;
begin
if OpenPictureDialog1.Execute then
begin
Screen.Cursor := crHourGlass;
try
fPal := nil;
try
fStringList := TStringList.Create;
Image1.Picture.LoadFromFile( OpenPictureDialog1.Filename );
if Image1.Picture.Graphic.Palette <> 0 then
begin
GetMem( fPal, Sizeof( TLogPalette ) + Sizeof( TPaletteEntry ) * 255 );
fPal.palversion := $300;
fPal.palnumentries := 256;
fBitmapPalEntries := GetPaletteEntries( Image1.Picture.Graphic.Palette, 0, 256, fPal.palPalEntry[ 0 ] );
for i := 0 to fBitmapPalEntries - 1 do
begin
fColor := fPal.PalPalEntry[ i ].PeBlue shl 16
+ fPal.PalPalEntry[ i ].PeGreen shl 8
+ fPal.PalPalEntry[ i ].PeRed;
fColorString := ColorToString( fColor );
fStringList.Add( fColorString );
end;
end;
finally; FreeMem( fPal ); end;
if fStringList.Count = 0 then
ShowMessage('No palette entries!')
else
// add the colors to the colorpicker here
fStringList.Free;
finally; Screen.Cursor := crDefault; end;
end;