Как я могу получить доступ к палитре TPicture.Graphic?

Question

Я искал в Интернете часами, но я не могу найти ничего о том, как получить палитру из TPicture.Graphic. Мне также нужно получить значения цвета, чтобы передать эти значения в TStringList для заполнения ячеек в colorpicker.

Вот код, который я в настоящее время есть:

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

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

Answer 3

Замечательный ресурс графических алотиформ доступен по адресу efg's reference library, который включает в себя отдельный раздел, посвященный только цвету. В частности, статья this (с источником) обсуждает подсчет доступных цветов и может быть наилучшим образом использована.

Answer 4

Thank you вы все .... в частности 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;