Delphi convert gif to png with transparency

Question

I'm trying to convert gif to png, it's simple, but the problem is that the image result is not transparent, also I would like to have an alpha channel in the png image.

This is my code:

procedure TForm1.Button1Click(Sender: TObject);
var
png: TPngImage;
 p : TPicture;
begin
 p := TPicture.Create;
 p.LoadFromFile('C:\temp\php.gif');
 png := TPngImage.CreateBlank(COLOR_RGB , 8, p.Width, p.Height);
 png.Canvas.Draw(0,0, p.Graphic);
 png.SaveToFile('C:\Windows\Temp\test.png');
end;

The new image has a black background, it should be transparent.

If I try to add ALPHA in the constructor, it is 100% transparent.

png := TPngImage.CreateBlank(COLOR_RGBALPHA , 8, p.Width, p.Height);

Answer 1

Simply, drawing a GIF image on a PNG canvas will not transfer transparency information from a GIF image to a PNG. You will have to do it yourself.

The ForceAlphaChannel procedure will create an alpha channel for any PNG image based on this TransparentColor.

procedure ForceAlphaChannel(Image: TPngImage; BitTransparency: Boolean; TransparentColor: TColor; Amount: Byte);
var
  Temp: TPngImage;
  x, y: Integer;
  Line: VCL.Imaging.PngImage.pByteArray;
  PixColor: TColor;
begin
  Temp := TPngImage.CreateBlank(COLOR_RGBALPHA, 8, Image.Width, Image.Height);
  try
    for y := 0 to Image.Height - 1 do
      begin
        Line := Temp.AlphaScanline[y];
        for x := 0 to Image.Width - 1 do
          begin
            PixColor := Image.Pixels[x, y];
            Temp.Pixels[x, y] := PixColor;
            if BitTransparency and (PixColor = TransparentColor) then Line^[x] := 0
            else Line^[x] := Amount;
          end;
      end;
    Image.Assign(Temp);
  finally
    Temp.Free;
  end;
end;

ForceAlphaChannel , GIF, , .

procedure TForm1.Button1Click(Sender: TObject);
var
png: TPngImage;
 p : TPicture;
 TransparentColor: TColor;
begin
 p := TPicture.Create;
 p.LoadFromFile('C:\temp\php.gif');
 TransparentColor := clFuchsia;
 png := TPngImage.CreateBlank(COLOR_RGB , 8, p.Width, p.Height);
 // set png background color to same color that will be used for setting transparency
 png.Canvas.Brush.Color := TransparentColor;
 png.Canvas.FillRect(rect(0, 0 , p.Width, p.Height));
 png.Canvas.Draw(0, 0, p.Graphic);
 ForceAlphaChannel(png, true, TransparentColor, 255);
 png.SaveToFile('C:\Windows\Temp\test.png');
end;

Answer 2

Delphi XE 2 GDI +, .
TGPImage, , mime.

uses Winapi.GDIPAPI, Winapi.GDIPOBJ, Winapi.GDIPUTIL;

procedure TForm8.Button1Click(Sender: TObject);
var
  encoderClsid: TGUID;
  stat: TStatus;
  IMG: TGPImage;
begin
  IMG := TGPImage.Create('C:\temp\transparent.gif');
  try
    GetEncoderClsid('image/png', encoderClsid);
    stat := IMG.Save('C:\temp\transparent.png', encoderClsid, nil);
  finally
    IMG.Free;
  end;
  if (stat = Ok) then
    Showmessage('Success');
end;

mime:

image/bmp
image/jpeg
image/gif
image/tiff
image/png

Answer 3

/ Delphi ( - TPngObject TPngImage).

() GIF PNG ( GIFS):

pngimage 1.56+ ( CreateBlank)

procedure TForm1.Button1Click(Sender: TObject);
var
  Gif: TGifImage;
  Png: TPngObject; // for new Delphi versions use "TPngImage"
  Bmp: TBitmap;
  TransparentColor, Pixel: TColor;
  I, X, Y: Integer;
  AlphaScanline: pByteArray;
  IsTransparent: Boolean;
  ColorType: Cardinal;
begin
  Gif := TGifImage.Create;
  try
    Gif.LoadFromFile('C:\Downloads\ajax-loader.gif');
    for I := 0 to Gif.Images.Count - 1 do
    begin
      IsTransparent := Gif.Images[I].Transparent;
      TransparentColor := Gif.Images[I].GraphicControlExtension.TransparentColor;
      Bmp := Gif.Images[I].Bitmap;
      if IsTransparent then
        ColorType := COLOR_RGBALPHA
      else
        ColorType := COLOR_RGB;
      Png := TPngObject.CreateBlank(ColorType, 8, Bmp.Width, Bmp.Height); // for new Delphi versions use "TPngImage"
      try
        AlphaScanline := nil;
        for Y := 0 to Bmp.Height - 1 do
        begin
          if IsTransparent then
            AlphaScanline := Png.AlphaScanline[Y];
          for X := 0 to Bmp.Width - 1 do
          begin
            Pixel := Bmp.Canvas.Pixels[X, Y];
            Png.Pixels[X, Y] := Pixel;
            if IsTransparent then
            begin
              if (Pixel = TransparentColor) then
                AlphaScanline^[X] := 0
              else
                AlphaScanline^[X] := 255;
            end;
          end;
        end;
        Png.SaveToFile(Format('%d.png', [I]));
      finally
        Png.Free;
      end;
    end;
  finally
    Gif.Free;
  end;
end;

pngimage 1.56, TPngObject.CreateBlank:

procedure TForm1.Button2Click(Sender: TObject);
var
  Gif: TGifImage;
  Png: TPngObject; // for new Delphi versions use "TPngImage"
  Bmp: TBitmap;
  TransparentColor, Pixel: TColor;
  I, X, Y: Integer;
  AlphaScanline: pByteArray;
  IsTransparent: Boolean;
begin
  Gif := TGifImage.Create;
  try
    Gif.LoadFromFile('C:\Downloads\ajax-loader.gif');
    for I := 0 to Gif.Images.Count - 1 do
    begin
      IsTransparent := Gif.Images[I].Transparent;
      Png := TPngObject.Create; // for new Delphi versions use "TPngImage"
      try
        if IsTransparent then
        begin
          Bmp := TBitmap.Create;
          Bmp.Assign(Gif.Images[I].Bitmap);
          Bmp.PixelFormat := pf24bit;
          Png.Assign(Bmp);              
          Png.CreateAlpha;
          TransparentColor := Gif.Images[I].GraphicControlExtension.TransparentColor;
          for Y := 0 to Bmp.Height - 1 do
          begin
            AlphaScanline := Png.AlphaScanline[Y];
            for X := 0 to Bmp.Width - 1 do
            begin
              Pixel := Png.Pixels[X, Y];
              if (Pixel = TransparentColor) then
                AlphaScanline^[X] := 0;
            end;
          end;
          Bmp.Free;
        end
        else
          Png.Assign(Gif.Images[I].Bitmap);
        Png.SaveToFile(Format('%d.png', [I]));
      finally
        Png.Free;
      end;
    end;
  finally
    Gif.Free;
  end;
end;