delphi конвертировать gif в png с прозрачностью

Question

Я пытаюсь преобразовать gif в png, это легко, но проблема в том, что результат изображения не прозрачен, также я хотел бы иметь в png-изображении альфа-канал.

Это мой код:

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); 

Answer 1

Просто рисунок GIF изображение на холсте PNG не сдвинется информации о прозрачности от GIF изображений в формат PNG. Вам нужно будет сделать это самостоятельно.

Процедура ForceAlphaChannel создаст альфа-канал для любого PNG-изображения на основе данного 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; 

примеры типов пантомимы:

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

Answer 3

Для более старых/новых версий Delphi (в новой версии - изменения TPngObject к TPngImage).

Если вам нужно сохранить каждый кадр (анимированный) GIF в PNG (работает неанимированного ГИФС также):

Первый вариант кода совместим с новой 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;