Как я могу получить доступ к палитре 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;

Я рисую на холсте ABitmap с изображением, содержащимся в Image1.Picture.Graphic, потому что я хочу поддерживать все типы изображений 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

Спасибо всем .... особенно Мги. Нам удалось заставить код работать очень хорошо для файлов 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;

Answer 4

Я сам не знаю, но вы можете взглянуть на XN Resource Editor , который отображает информацию о палитре, написан на Delphi и имеет доступный источник.