如何访问 TPicture.Graphic 的调色板？

Question

我已经在网上搜索了几个小时，但找不到任何有关如何从 TPicture.Graphic 获取调色板的信息。 我还需要获取颜色值，以便可以将这些值传递到 TStringList 以填充颜色选择器中的单元格。

这是我当前拥有的代码：

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;

我正在使用 Image1.Picture.Graphic 中包含的图像绘制到 ABitmap 的画布上，因为我想支持所有 TPicture 图像类型，例如 Bitmap、Jpeg、PngImage 和 GIfImg。

任何援助将不胜感激。 我走在正确的道路上还是需要一些不同的东西？

Answer 1

您发布的代码实际上没有任何作用。 您要么必须从位图中读回调色板，然后才能访问它，要么需要创建一个调色板并将其分配给位图 - 您的代码两者都不会。

以下代码或多或少是您的代码，其中 fBitmap 和 fBitmapPalEntries 字段用于操作结果。 我评论了我更改的所有行：

  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;

支持具有较少条目的调色板很容易，您只需在知道有多少条目后重新分配内存，

ReallocMem(Pal, SizeOf(TLogPalette) + SizeOf(TPaletteEntry) * (fBitmapPalEntries - 1));

只有当您想编写位图时才需要创建调色板 之类的东西采用 pf4Bit 或 pf8Bit 格式。 您可能需要通过减少颜色数量（抖动）来确定调色板条目的 16 或 256 种颜色。 然后，您将使用颜色值填充调色板颜色槽，最后使用我从代码中注释掉的两行。 您必须确保位图的像素格式和调色板条目的数量匹配。

Answer 2

efg 的参考库提供了精彩的图形算法资源其中包括仅处理颜色的特定部分。 具体来说这篇文章（带有源代码）讨论了计算可用颜色并可能物尽其用。

Answer 3

我自己也不了解，但您可以看看 XN 资源编辑器，它确实显示调色板信息，是用 Delphi 编写的并且有可用的源代码。

Answer 4

谢谢大家……尤其是 mghie。 我们设法使代码能够很好地处理 bmp、png 和 gif 文件以及 pf1bit、pf4bit、pf8bit、pf16bit 和 pf24bit 图像。 我们仍在测试代码，但到目前为止它似乎运行得很好。 希望这段代码也能帮助其他开发人员。

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;