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

我已经在网上搜索了几个小时，但是我找不到任何关于如何从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的画布上，因为我希望支持所有的图片图像类型，如位图、Jpeg、PngImage和GIfImg

---

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

我不知道自己，但你可以看看，它确实显示调色板信息，是用Delphi编写的，并且有可用的源代码。

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

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

以下代码或多或少是您的代码，其中包含用于操作结果的字段

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;

---

仅当您希望以

pf4Bit

或

pf8Bit

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

谢谢大家。。。。尤其是姆吉。我们设法使代码在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;

var
i：整数；
fStringList:TStringList；
f颜色：t颜色；
fColorString：字符串；
fPal:plogpalete；
fBitmapPalEntries：红衣主教；
开始
如果是OpenPictureDialog1
开始
Screen.Cursor:=crHourGlass；
尝试
fPal:=零；
尝试
fStringList:=TStringList.Create；
Image1.Picture.LoadFromFile（OpenPictureDialog1.Filename）；
如果Image1.Picture.Graphic.Palette为0，则
开始
GetMem（fPal，Sizeof（tlogpalete）+Sizeof（tpaletentry）*255）；
fPal.palversion:=300美元；
fPal.palnumentries:=256；
fBitmapPalEntries:=GetPaletteEntries（Image1.Picture.Graphic.palete，0,256，fPal.palPalEntry[0]）；
对于i:=0到fBitmapPalEntries-1 do
开始
F颜色：=fPal.触诊法[i].北京蓝shl 16
+fPal.触诊学[i].佩格林第8卷
+触诊法[i].佩雷德；
fColorString:=彩色字符串（fColor）；
fStringList.Add（fColorString）；
结束；
结束；
最后FreeMem（fPal）；结束；
如果fStringList.Count=0，则
ShowMessage（'没有调色板条目！'）
其他的
//在此处将颜色添加到颜色选择器
fStringList.Free；
最后Screen.Cursor:=crDefault；结束；
结束；

我花了好几个小时研究这段源代码，我认为其中有些是不完整的。代码是Delphi7的，非常复杂。。。。至少对我来说是这样。谢谢你的回答。我正在研究mghie重写的代码。由于fBitmap不是直接从文件中加载的，您知道如何获取其pixelformat吗？我已经编辑了您的问题标题并删除了第一句话，因为问题似乎只是访问现有调色板，而不是创建调色板。

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;