2

我已经在网上搜索了几个小时，但我找不到任何关于如何从 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。

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

4

4 回答 4

3

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

以下代码或多或少是您的，包含字段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 种颜色。然后你会用颜色值填充调色板颜色槽，最后使用我从你的代码中注释掉的两行。您必须确保位图的像素格式和调色板条目的数量匹配。

于 2009-08-06T21:01:50.647 回答
1

efg 的参考库中提供了一个很棒的图形算法资源，其中包括一个专门处理颜色的部分。具体来说，这篇文章（带有源代码）讨论了计算可用颜色，并且可能是最好的用途。

于 2009-08-06T20:57:53.337 回答
0

我自己不认识，但您可能会看一下XN Resource Editor，它确实显示调色板信息，是用 Delphi 编写的，并且有可用的源代码。

于 2009-08-06T19:52:34.317 回答
0

谢谢大家....尤其是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;
于 2009-08-07T03:22:48.613 回答