Delphi如何将带透明度的GIF转换为PNG？

Question

我正在尝试将gif转换为png，这很容易，但问题是结果图像不透明，而且我希望在png图像中有alpha通道。

这是我的代码:

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;

新图片的背景是黑色的，应该是透明的。

如果我在构造函数中尝试添加 ALPHA，则是100％透明的。

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

- Max1298492

---

尝试打开 TGraphic 的透明度。默认为 false。p.Graphic.Transparent := True; - Peter Kostov

谢谢你的回答，但是它不起作用。 - Max1298492

嗨Max，你在用哪个Delphi版本？我在你以前的问题中找到了XE 5。我可以提供一个非常简单的解决方案，没有任何人工制品。 - bummi

Answer 1

自从 Delphi XE2 支持 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

- bummi

Answer 2

仅仅在PNG画布上绘制GIF图像并不能将透明信息从GIF图像移动到PNG中。 你需要自己操作。 ForceAlphaChannel过程将基于给定的TransparentColor为任何PNG图像创建alpha通道。

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;

如果你在绘制GIF图像后添加ForceAlphaChannel调用，你将根据你定义的透明颜色获得透明度。

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;

- Dalija Prasnikar

Answer 3

对于旧版本/新版本的Delphi（在新版本中-将TPngObject更改为TPngImage）。

如果您需要将（动画）GIF的每个帧保存为PNG（也适用于非动画GIF）：

第一种代码变体与较新的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;

- kobik