Bug Bitmap/PixelFormat

[Antonio]

Suite à quelques essais, j'ai constaté un bug(?) au niveau de Delphi

Code : Tout sélectionner

procedure TForm1.Button1Click(Sender: TObject);
var
  Bitmap: TBitmap;
begin
  // création du bitmap de test au format 24 bits (natif PhotoFiltre)
  Bitmap := TBitmap.Create;
  with Bitmap do
  begin
    PixelFormat := pf24bit;
    Width := 100;
    Height := 100;
  end;

  // remplissage avec la couleur (255, 204, 0)
  with Bitmap.Canvas do
  begin
    Brush.Color := RGB(255, 204, 0);
    FillRect(ClipRect);
  end;

  // Modification de format (4 bits, 16 couleurs maxi)
  // ici on a qu'une couleur !!!
  Bitmap.PixelFormat := pf4bit;
  // ==> la valeur jaune est modifiée en (255, 255, 0) par cette conversion

  Bitmap.SaveToFile('c:\essai$$1.bmp');
  Bitmap.Free;
end;

Dans les sources Delphi, j'ai remarqué que SetPixelFormat forçait une palette système 16 bits. Je vois pas trop comment régler ce problème sans refaire une fonction de conversion...

[Benjamin]

Tu n'utilise pas les fonctions de TGifImage en fait?

Apparement d'après les test de Pascal ce la fonctionne dans ce cas là mais il faut sans doute les adapter...

[Antonio]

TGifImage ne sait réduire qu'en format 8 bits (256 couleurs maxi). En fait c'est la taille de la palette qui est réduite et non le format.

mais j'ai refait une fonction de conversion, finalement elle est pas très compliquée.

[Benjamin]

Non et au moins tu peux controler la stratégie de réduction des couleurs...

J'en avais fait une au siècle dernier j'avais sélectionné les n couleurs les plus utilisées puis je recherchais la couleur la plus proche pour les autres couleurs mais cela ne donnait pas toujours de bon résultats... Mais y a des algos plus performant que celui là

[Antonio]

C'est beaucoup plus simple car j'utilise le travail effectué par TGifImage. Je part donc d'un Bitmap en 8 bits dont la palette est déjà triée. Je convertis en 4 bits en prenant uniquement les 16 premières couleurs

Code : Tout sélectionner

procedure Convert8bitTo4bit(BmpSrc, BmpDest: TBitmap);
var
  LogPal: TMaxLogPalette;
  Palette: HPalette;
  Row4, Row8 : pByteArray;
  I, J: Integer;
begin
  if BmpSrc.PixelFormat <> pf8bit then Exit;

  // création du bitmap destination 4 bit
  BmpDest.Assign(nil);
  BmpDest.PixelFormat := pf4bit;
  BmpDest.Width := BmpSrc.Width;
  BmpDest.Height := BmpSrc.Height;

  // création de la palette par duplication
  LogPal.palVersion := $0300;
  LogPal.palNumEntries := 16;
  GetPaletteEntries(BmpSrc.Palette, 0, 16, LogPal.palPalEntry);
  Palette := CreatePalette(PLogPalette(@LogPal)^);
  BmpDest.Palette := Palette;

  // recopie les pixels
  for J := 0 to BmpDest.Height - 1 do
  begin
    Row4 := BmpDest.Scanline[J];
    Row8 := BmpSrc.Scanline[J];
    for I := 0 to BmpDest.Width div 2 - 1 do
      Row4[I] := Row8[2 * I] shl 4 + Row8[2 * I + 1];
  end;
end;

[Benjamin]

Ah oui d'accord j'avais pas compris le problème en fait...

Cette bitmap 4 bits elle sert au moment de l'enregistrement?

[Antonio]

Oui, uniquement