procedure TForm1.Button2Click(Sender: TObject);
var
i: integer;
fStringList: TStringList;
fColor: TColor;
fColorString: string;
fPal: PLogPalette;
fBitmapPalEntries: Cardinal;
fBitmap: TBitmap;
begin
if OpenPictureDialog1.Execute then
begin
Screen.Cursor := crHourGlass;
try
fPal := nil;
try
fStringList := TStringList.Create;
Image1.Picture.LoadFromFile( OpenPictureDialog1.Filename );
fBitmap := TBitmap.Create;
fBitmap.PixelFormat := pf8bit;
//fBitmap.Assign(Image1.Picture.Graphic);
fBitmap.Canvas.Draw( 0, 0, Image1.Picture.Graphic );
if fBitmap.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
fStringList.Free;
finally; Screen.Cursor := crDefault; end;
end;
end;