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