Resize d'un PNG transparent [Résolu]

Nico8583 7 Messages postés jeudi 1 mars 2007Date d'inscription 24 mai 2014 Dernière intervention - 11 mai 2014 à 01:25 - Dernière réponse : Cirec 4231 Messages postés vendredi 23 juillet 2004Date d'inscriptionModérateurStatut 3 août 2018 Dernière intervention
- 31 mai 2014 à 14:27
Bonjour,
Je travaille sur XE2 et j'essaye de convertir un fichier PNG qui possède une transparence (et apparemment une palette) mais sans succès. Je suis toujours bloqué par quelque chose (soit l'ouverture et l'enregistrement me rajoute un contour de pixels blanc, soit le fond reste noir au lieu de transparent...), même si la bibliothèque Graphics32 semble permettre d'y arriver.
J'ai également trouvé cette fonction pour ouvrir et enregistrer des PNG :
http://www.codenewsfast.com/cnf/article/0/waArticleBookmark.7242285
Pour compléter, voici un exemple d'un fichier PNG que j'essaie de resizer : http://dl.free.fr/nzNp2G5FY
Quelqu'un aurait-il un code pour faire un resize d'un PNG transparent ?
Merci !
Afficher la suite 

Votre réponse

10 réponses

Meilleure réponse
Cirec 4231 Messages postés vendredi 23 juillet 2004Date d'inscriptionModérateurStatut 3 août 2018 Dernière intervention - 20 mai 2014 à 12:52
1
Merci
Salut,

1°) je confirme le fichier png fourni en exemple est bien disponible en téléchargement !

2°) le fichier png en question est un PNG8 ... et possède donc une palette indexée et le problème semble venir d'ici.
à la conversion en Bitmap32 les données ne semblent pas être justes ou incomplètes.

Puisqu'en convertissant le PNG8 en PNG32 (passer de couleurs indexées à RVB) avec gimp (ou autre) tout se passe très bien. La conversion en Bitmap32 le resize et le "retour" au format PNG (le tout sous Delphi)

Merci Cirec 1

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 94 internautes ce mois-ci

Nico8583 7 Messages postés jeudi 1 mars 2007Date d'inscription 24 mai 2014 Dernière intervention - 20 mai 2014 à 13:31
Merci pour la réponse.
Effectivement le fichier est un PNG8 mais je ne sais pas comment je peux le traiter sous Delphi XE2.
korgis 424 Messages postés samedi 17 mai 2003Date d'inscription 4 août 2018 Dernière intervention - 20 mai 2014 à 14:13
Salut,

"le fichier png fourni en exemple est bien disponible en téléchargement"

1°) C'est vrai, avec Chrome et IE.
Mais pas sous Firefox 28.0 avec Adblock...

2°) Mais là n'est pas vraiment la question, n'est-il pas ?
Et là, je cède la place au spécialiste ;-)
Commenter la réponse de Cirec
Meilleure réponse
Cirec 4231 Messages postés vendredi 23 juillet 2004Date d'inscriptionModérateurStatut 3 août 2018 Dernière intervention - 23 mai 2014 à 21:58
1
Merci
re,

j'ai bien une solution mais elle exige que l'on possède le fichier source "PNGImage.pas" ...
de modifier la portée des variables "Private" en "Protected" de l'objet "TChunckIHDR" et voilà ...

on a ainsi accès à toutes les données pour extraire proprement un PNG8, avec palette en Bitmap32, qui est fidèle à l'originale avec un canal alpha.

le code peut convertir tout fichier Png 1,4,8,24 bits


C'est pas la solution la plus élégante mais elle est rapide et simple à mettre en oeuvre et donne un résultat fidèle à l'originale et il est même possible d'effectuer le redimensionnement directement à la conversion ...

Si toute fois la méthode vous intéresse quand même dites le et je posterais la marche à suivre et le code.

Merci Cirec 1

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 94 internautes ce mois-ci

Commenter la réponse de Cirec
Meilleure réponse
Cirec 4231 Messages postés vendredi 23 juillet 2004Date d'inscriptionModérateurStatut 3 août 2018 Dernière intervention - 23 mai 2014 à 23:07
1
Merci
comme le code a été demandé sur l'autre site je le mets également à disposition ici:

1°) faire une copie de "pngimage.pas" dans le répertoire de ton application:

2°) dans cette copie à la ligne 490 devrait commencer l'objet "TChunckIHDR" que tu modifies comme suit:
 {Information header chunk}
  TChunkIHDR = class(TChunk)
  protected                           // *** ajouté
  //private                           // *** mis en commentaire
    {Current image}
    ImageHandle: HBitmap;
    ImageDC: HDC;
    ImagePalette: HPalette;
    {Output windows bitmap}
    HasPalette: Boolean;
    BitmapInfo: TMaxBitmapInfo;
    {Stores the image bytes}
    {$IFDEF Store16bits}ExtraImageData: Pointer;{$ENDIF}
    ImageData: pointer;
    ImageAlpha: Pointer;

    {Contains all the ihdr data}
    IHDRData: TIHDRData;
//  protected                         // *** mis en commentaire
    BytesPerRow: Integer;


l'unité "UPng2Bmp32.pas" qui fait tout le boulot:
unit UPng2Bmp32;

interface
uses Windows, SysUtils, Graphics, PngImage;
procedure PartialTransPng2Bmp32(aPNGImage: TPNGImage; aBMP: TBitmap);

implementation

type
  // l'astuce qui permet d'avoir accès à la section Protected
  // de la classe TChunckIHDR
  THackChunkIHDR = class(TChunkIHDR);

{Copy a PNG to a BMP32 using partial transparency
 Original code grabed from PngImage.pas:
 procedure TPngImage.DrawPartialTrans(DC: HDC; Rect: TRect);
 adapted by Cirec}
procedure PartialTransPng2Bmp32(aPNGImage: TPNGImage; aBMP: TBitmap);
type
  {Access to pixels}
  TPixelLine = Array[Word] of TRGBQuad;
  pPixelLine = ^TPixelLine;
var
  Header: THackChunkIHDR;

  {Transparency/palette chunks}
  TransparencyChunk: TChunktRNS;
  PaletteChunk: TChunkPLTE;
  PaletteIndex: Byte;
  CurBit: Integer;
  Data: PByte;

  {Buffer bitmap modification}
  BytesPerRowDest,
  BytesPerRowSrc,
  BytesPerRowAlpha: Integer;
  ImageSource, ImageSourceOrg,
  AlphaSource     : pByteArray;
  ImageData       : pPixelLine;
  i, j, i2, j2    : Integer;

  {For bitmap stretching}
  W, H            : Cardinal;
  Stretch         : Boolean;
  FactorX, FactorY: Double;
begin
  if not Assigned(aBMP) then Exit;
  aBMP.PixelFormat := pf32bit;
  W := aBMP.Width;
  H := aBMP.Height;

  Header := THackChunkIHDR(aPNGImage.Header); {Fast access to header}
  Stretch := (W <> Header.Width) or (H <> Header.Height);
  if Stretch then FactorX := W / Header.Width else FactorX := 1;
  if Stretch then FactorY := H / Header.Height else FactorY := 1;

  {Obtain number of bytes for each row}
  BytesPerRowAlpha := Header.Width;
  BytesPerRowDest := (((32 * W) + 31) and not 31) div 8; {Number of bytes for each image row in destination}
  BytesPerRowSrc := (((Header.BitmapInfo.bmiHeader.biBitCount * Header.Width) +
    31) and not 31) div 8; {Number of bytes for each image row in source}

  {Obtains image pointers}
  ImageData := aBMP.ScanLine[0];
  AlphaSource := Header.ImageAlpha;
  Longint(ImageSource) := Longint(Header.ImageData) +
    Header.BytesPerRow * Longint(Header.Height - 1);
  ImageSourceOrg := ImageSource;

  case Header.BitmapInfo.bmiHeader.biBitCount of
    {R, G, B images}
    24:
      FOR j := 1 TO H DO
      begin
        {Process all the pixels in this line}
        FOR i := 0 TO W - 1 DO
        begin
          if Stretch then i2 := trunc(i / FactorX) else i2 := i;
          pRGBTriple(@ImageData[i])^ := pRGBTriple(@ImageSource[i2 * 3])^;
          ImageData[i].rgbReserved := AlphaSource[i2];
        end;

        {Move pointers}
        Dec(Longint(ImageData), BytesPerRowDest);
        if Stretch then j2 := trunc(j / FactorY) else j2 := j;
        Longint(ImageSource) := Longint(ImageSourceOrg) - BytesPerRowSrc * j2;
        Longint(AlphaSource) := Longint(Header.ImageAlpha) + BytesPerRowAlpha * j2;
      end;
    {Palette images with 1 byte for each pixel}
    1,4,8: if Header.ColorType = COLOR_GRAYSCALEALPHA then
      FOR j := 1 TO H DO
      begin
        {Process all the pixels in this line}
        FOR i := 0 TO W - 1 DO
          with ImageData[i], Header.BitmapInfo do begin
            if Stretch then i2 := trunc(i / FactorX) else i2 := i;
            rgbRed := ImageSource[i2];
            rgbGreen := ImageSource[i2];
            rgbBlue := ImageSource[i2];
            rgbReserved := AlphaSource[i2];
          end;

        {Move pointers}
        Longint(ImageData) := Longint(ImageData) - BytesPerRowDest;
        if Stretch then j2 := trunc(j / FactorY) else j2 := j;
        Longint(ImageSource) := Longint(ImageSourceOrg) - BytesPerRowSrc * j2;
        Longint(AlphaSource) := Longint(Header.ImageAlpha) +
          BytesPerRowAlpha * j2;
      end
    else {Palette images}
    begin//******************
      {Obtain pointer to the transparency chunk}
      TransparencyChunk := TChunktRNS(aPNGImage.Chunks.ItemFromClass(TChunktRNS));
      PaletteChunk := TChunkPLTE(aPNGImage.Chunks.ItemFromClass(TChunkPLTE));

      FOR j := 1 TO H DO
      begin
        {Process all the pixels in this line}
        i := 0;
        repeat
          CurBit := 0;
          if Stretch then i2 := trunc(i / FactorX) else i2 := i;
          Data := @ImageSource[i2];

          repeat
            {Obtains the palette index}
            case Header.BitDepth of
              1: PaletteIndex := (Data^ shr (7-(I Mod 8))) and 1;
            2,4: PaletteIndex := (Data^ shr ((1-(I Mod 2))*4)) and $0F;
             else PaletteIndex := Data^;
            end;

            {Updates the image with the new pixel}
            with ImageData[i] do
            begin
              rgbReserved := TransparencyChunk.PaletteValues[PaletteIndex];
              rgbRed := PaletteChunk.Item[PaletteIndex].rgbRed;
              rgbGreen := PaletteChunk.Item[PaletteIndex].rgbGreen;
              rgbBlue := PaletteChunk.Item[PaletteIndex].rgbBlue;
            end;

            {Move to next data}
            inc(i); inc(CurBit, Header.BitmapInfo.bmiHeader.biBitCount);
          until CurBit >= 8;
        until i >= Integer(W);

        {Move pointers ********}
        Longint(ImageData) := Longint(ImageData) - BytesPerRowDest;
        if Stretch then j2 := trunc(j / FactorY) else j2 := j;
        Longint(ImageSource) := Longint(ImageSourceOrg) - BytesPerRowSrc * j2;
      end
    end {Palette images **********}
  end {case Header.BitmapInfo.bmiHeader.biBitCount};
end;



end.


et pour tester une fiche deux TImage et un TButton et pngimage dans les uses:
...
var
  Form1: TForm1;
  aPng: TPngImage;
implementation

{$R *.dfm}
uses UPng2Bmp32;


procedure TForm1.FormCreate(Sender: TObject);
begin
  aPng := TPngImage.Create;
  aPng.LoadFromFile('Output_0001.png');
  Image1.Picture.Assign(aPng);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  aPng.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  aBMP: TBitmap;
begin
  aBMP := TBitmap.Create;
  try
    aBMP.Width := aPNG.Width;   // aPNG.Width div 2;
    aBMP.Height := aPNG.Height; // aPNG.Height div 2;
    aBMP.PixelFormat := pf32bit;
    if aPng.TransparencyMode = ptmPartial then
      PartialTransPng2Bmp32(aPNG, aBMP);
    aBMP.SaveToFile('Png2BMP32.bmp');
    aBMP.AlphaFormat := afPremultiplied;
    Image2.Picture.Assign(aBMP);
  finally
    aBMP.Free;
  end;

end;

end.


voilà

Merci Cirec 1

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 94 internautes ce mois-ci

Nico8583 7 Messages postés jeudi 1 mars 2007Date d'inscription 24 mai 2014 Dernière intervention - 24 mai 2014 à 14:32
Merci beaucoup pour ce code que je vais tester dès que possible ;)
Commenter la réponse de Cirec
Nico8583 7 Messages postés jeudi 1 mars 2007Date d'inscription 24 mai 2014 Dernière intervention - 15 mai 2014 à 20:38
0
Merci
Personne ne fait de resize PNG sous Delphi ? :)
korgis 424 Messages postés samedi 17 mai 2003Date d'inscription 4 août 2018 Dernière intervention - 16 mai 2014 à 13:39
Si, plein de gens font ça.

Mais pas ici... ;-)

Ton lien "http://dl.free.fr/nzNp2G5FY" ne pointe sur rien.

Tu as l'air d'avoir bien avancé sur le sujet : si tu nous montrais un bout de code (à toi), ça nous ferait un truc à se mettre sous la dent pour le week-end (encore que, vu la météo, je vais plutôt aller me promener avec Suzette).

A+
Nico8583 7 Messages postés jeudi 1 mars 2007Date d'inscription 24 mai 2014 Dernière intervention - 16 mai 2014 à 20:01
Ok je vais essayer de poster un bout de code mais j'ai tellement essayé de chose que je sais pas à partir duquel partir :)
Et mon lien je viens de vérifier pourtant et je peux télécharger le fichier que j'ai posté...
Commenter la réponse de Nico8583
Cirec 4231 Messages postés vendredi 23 juillet 2004Date d'inscriptionModérateurStatut 3 août 2018 Dernière intervention - 31 mai 2014 à 14:27
0
Merci
re,
pour finir je vous donne aussi la fonction de retour qui permet de reconvertir le Bitmap redimensionné en PNG avec compression maximale:
unit UBmp32ToPng;

interface
uses Windows, SysUtils, Graphics, PngImage;

function Bmp32ToPng(SrcBmp: TBitmap): TPngImage;

implementation

function Bmp32ToPng(SrcBmp: TBitmap): TPngImage;
var
  X, Y            : Integer;
  SrcPixLine,
  DestPixLine     : Pointer;
  PSrcPixLine     : PRGBQuad absolute SrcPixLine;
  PDestPixLine    : PRGBTriple absolute DestPixLine;
  IsPremultiplied : Boolean;
begin
  if not assigned(SrcBmp) or (SrcBmp.PixelFormat <> pf32Bit) or (SrcBmp.Empty) or
    ((SrcBmp.Width <= 0) or (SrcBmp.Height <= 0)) then
     raise EInvalidGraphicOperation.Create('Bitmap invalide. Impossible à convertir') ;

  Result := TPNGImage.CreateBlank(COLOR_RGBALPHA, 8, SrcBmp.Width, SrcBmp.Height);
  with Result do
  try
    IsPremultiplied := SrcBmp.AlphaFormat = afPremultiplied;
    if IsPremultiplied then
      SrcBmp.AlphaFormat := afIgnored;
    // on sélectionne tous les filtres pour une meilleur compression
    Filters := [pfNone, pfSub, pfUp, pfAverage, pfPaeth];
    for Y := 0 to SrcBmp.Height - 1 do
    begin
      SrcPixLine := SrcBmp.ScanLine[Y];
      DestPixLine := Scanline[Y];

      for X := 0 to SrcBmp.Width - 1 do
      begin
        PDestPixLine^ := PRGBTriple(PSrcPixLine)^;
        AlphaScanline[Y]^[X] := PSrcPixLine^.rgbReserved;

        Inc(PSrcPixLine);
        Inc(PDestPixLine);
      end;
    end;

  finally
    if IsPremultiplied then
      SrcBmp.AlphaFormat := afPremultiplied;
  end;
end;
end.


à utiliser comme ceci:
  with Bmp32ToPng(aBMP2) do
  try
    SaveToFile('Cirec.png');
  finally
    Free;
  end;


surtout ne jamais faire:
Bmp32ToPng(aBMP2).SaveToFile('Cirec.png');

la référence à l'objet retournée par la fonction serait ainsi perdue et l'objet ne pourrait plus être libéré

une autre solution existe:
var
  aNewPng: TPNGImage;
begin
  aNewPng := Bmp32ToPng(aBMP2);
  if Assigned(aNewPng) then
  try
    aNewPng.SaveToFile('Cirec.png'); 
  finally
    aNewPng.Free; 
  end;
end;


voilà vous avez tout et vous savez tout sur le sujet ...
Commenter la réponse de Cirec

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.