delphi将gif转换为具有透明度的png

时间:2014-11-28 08:19:55

标签: delphi png gif alpha-transparency

我正在尝试将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);

3 个答案:

答案 0 :(得分:3)

只需在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;

答案 1 :(得分:3)

由于支持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

答案 2 :(得分: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;

对于1.56之前的旧pngimage版本支持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;