如何访问Picture.Graphic的调色板?

时间:2009-08-06 18:44:30

标签: delphi graphics palette

我在网上搜了几个小时但是我找不到任何关于如何从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 个答案:

答案 0 :(得分:3)

您发布的代码没有真正做到。您必须先从位图中读取调色板,然后才能访问它,或者您需要创建一个调色板并将其分配给位图 - 您的代码都不会。

以下代码或多或少属于您的代码,其中包含字段fBitmapfBitmapPalEntries的操作结果。我评论了我改变的所有行:

  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));

只有在想要以pf4Bitpf8Bit格式编写位图时才需要创建调色板。您可能需要确定调色板条目的16或256种颜色,可能通过减少颜色数量(抖动)。然后,您将使用颜色值填充调色板颜色槽,最后使用我从代码中注释掉的两行。您必须确保位图的像素格式和调色板条目的数量匹配。

答案 1 :(得分:1)

efg's reference library提供了精彩的图形算法资源,其中包含一个仅处理颜色的特定部分。具体来说,this文章(包括来源)讨论了计算可用颜色的方法,可能是最佳用途。

答案 2 :(得分:0)

我不了解自己,但你可以看一下XN Resource Editor,它显示调色板信息,是用Delphi编写的,并且有源代码可用。

答案 3 :(得分: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;