Come posso accedere alla tavolozza di un tpicture.graphic?

Question

Ho cercato sul web per ore, ma non riesco a trovare nulla su come ottenere la tavolozza da un tpicture.graphic. Devo anche ottenere i valori di colore in modo da poter passare questi valori a una lista Tstring per riempire le celle in un colorpicker.

Ecco il codice che ho attualmente:

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;

Sto attingendo alla tela di AbitMap con l'immagine contenuta in Image1.Picture.Graphic Perché voglio supportare tutti i tipi di immagini TPicture come Bitmap, JPEG, PNGIMAGE e GIFIMG.

Qualsiasi assistenza sarebbe apprezzata. Sono sul percorso corretto o è necessario qualcosa di diverso?

Answer 1

Il codice che hai pubblicato non fa davvero nulla. Devi leggere la palette dalla bitmap prima di poter accedervi, oppure devi creare una tavolozza e assegnarla a una bitmap - il tuo codice non fa nessuno dei due.

Il seguente codice è più o meno tuo, con campi fBitmap e fBitmapPalEntries Per i risultati dell'operazione. Ho commentato tutte le righe che ho cambiato:

  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;

Il supporto per le palette con meno voci è facile, devi solo riallocare la memoria dopo aver saputo quante voci ci sono, qualcosa di simile

ReallocMem(Pal, SizeOf(TLogPalette) + SizeOf(TPaletteEntry) * (fBitmapPalEntries - 1));

La creazione di una tavolozza sarebbe necessaria solo se si desidera scrivere una bitmap pf4Bit o pf8Bit formato. Dovresti determinare i 16 o 256 colori che sono voci della tavolozza, possibilmente riducendo il numero di colori (dithering). Quindi riempiresti gli slot di colore della palette con i valori di colore e infine useresti le due righe che ho commentato dal tuo codice. Devi assicurarti che il formato pixel della bitmap e il numero di voci della tavolozza corrisponda.

Answer 2

Una meravigliosa risorsa di grafica alogitmi è disponibile su La libreria di riferimento di EFG che include una sezione specifica che si occupa solo di colore. Specificamente questo L'articolo (con la fonte) discute il conteggio dei colori disponibili e potrebbe essere del miglior utilizzo.

Answer 3

Non mi conosco, ma potresti dare un'occhiata XN Editor alle risorse, che visualizza le informazioni sulla tavolozza, è scritto in Delphi e ha una fonte disponibile.

Answer 4

Grazie a tutti .... specialmente Mghie. Siamo riusciti a far funzionare molto bene il codice per i file BMP, PNG e GIF e immagini PF1bit, PF4bit, PF8bit, PF16bit e PF24bit. Stiamo ancora tenendo il codice ma finora sembra funzionare molto bene. Spero che questo codice aiuti anche altri sviluppatori.

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;