TGifImage透明度问题 [英] TGifImage Transparency Issue

问题描述

我正在使用Delphi XE中包含的TGifImage。

我想要做的是从文件加载Gif，并将所有框架提取到位图。

这是我迄今为止所做的：

  ExtractGifFrames（FileName：string）; 
 var 
 Gif：TGifImage; 
 Bmp：TBitmap; 
 i：整数; 
 begin 
 Gif：= TGifImage.Create; 
 try 
 Gif.LoadFromFile（FileName）; 
 
 Bmp：= TBitmap.Create; 
 try 
 Bmp.SetSize（Gif.Width，Gif.Height）; 
 
 for i：= 0 to Gif.Images.Count  -  1 do 
 begin 
如果不是Gif.Images [i] .Empty then 
 begin 
 Bmp.Assign（Gif.Images [i]）; 
 Bmp.SaveToFile（'C：\test\bitmap'+ IntToStr（i）+'.bmp'）; 
结束
结束
 finally 
 Bmp.Free; 
结束
 finally 
 Gif.Free; 
结束
结束
 
 procedure TForm1.Button1Click（Sender：TObject）; 
 begin 
如果OpenPictureDialog1.Execute然后
 begin 
 ExtractGifFrames（OpenPictureDialog1.FileName）; 
结束
结束
  

我遇到的问题是有一些透明度问题，有很多不同的GIF，还有大小问题

以下是使用上面代码保存的一些示例位图：

如您所见，结果并不好，他们有大小和透明度问题。

我知道Gif文件本身没有被破坏，因为我可以通过我的网页浏览器加载它们，并且它们正确显示，没有错误。

如何加载一个来自File的GIF，将每个帧分配给Bitmap，而不会损失任何质量？

解决方案

如果您的源代码 GIFImage 单位，您可能需要检查 TGIFPainter 如何根据每个框架的 Disposa l 方法。 （看看（完全取代旧的 TGIFPainter ）例如：

  procedure TForm1.Button1Click（Sender：TObject）; 
 var 
 GIF：TGIFImage; 
位图：TBitmap; 
 I：整数; 
 GR：TGIFRenderer; 
 begin 
 GIF：= TGIFImage.Create; 
位图：= TBitmap.Create; 
 try 
 GIF.LoadFromFile（'c：\test\test.gif'）; 
 Bitmap.SetSize（GIF.Width，GIF.Height）; 
 GR：= TGIFRenderer.Create（GIF）; 
尝试
为I：= 0到GIF.Images.Count  -  1 do 
 begin 
如果GIF.Images [I] .Empty then Break; 
 GR.Draw（Bitmap.Canvas，Bitmap.Canvas.ClipRect）; 
 GR.NextFrame; 
 Bitmap.SaveToFile（Format（'％。2d.bmp'，[I]））; 
结束
 finally 
 GR.Free; 
结束
 finally 
 GIF.Free; 
 Bitmap.Free; 
结束
结束
  

使用德尔福2009 测试

I am using TGifImage that is included with Delphi XE.

What I am trying to do is load a Gif from a File and and extract all the frames to a Bitmap.

This is what I did so far:

procedure ExtractGifFrames(FileName: string);
var
  Gif: TGifImage;
  Bmp: TBitmap;
  i: Integer;
begin
  Gif := TGifImage.Create;
  try
    Gif.LoadFromFile(FileName);

    Bmp := TBitmap.Create;
    try
      Bmp.SetSize(Gif.Width, Gif.Height);

      for i := 0 to Gif.Images.Count - 1 do
      begin
        if not Gif.Images[i].Empty then
        begin
          Bmp.Assign(Gif.Images[i]);
          Bmp.SaveToFile('C:\test\bitmap' + IntToStr(i) + '.bmp');
        end;
      end;
    finally
      Bmp.Free;
    end;
  finally
    Gif.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenPictureDialog1.Execute then
  begin
    ExtractGifFrames(OpenPictureDialog1.FileName);
  end;
end;

The problem I am facing is with some transparency issue with a lot of different Gifs, and also size problems.

Here are some example bitmaps that were saved using my code above:

As you can see the results are not great, they have size and transparency issues.

I know the Gif Files themselves are not corrupt, because I can load them through my web browser and they display correctly without fault.

How can I load a Gif from File, assign each frame to Bitmap without losing any quality?

解决方案

If you have the source code of GIFImage unit, you might want to check how TGIFPainter renders the images based on each Frame's Disposal method. (take a look here - It might be an older version but you can still get the idea).

I have wrote a small code utilizing TGIFPainter.OnAfterPaint event handler to save the active frame to BMP, and do all the "hard work".

type
  TForm1 = class(TForm)
    Button1: TButton;
    ProgressBar1: TProgressBar;
    procedure Button1Click(Sender: TObject);
  public
    FBitmap: TBitmap;
    procedure AfterPaintGIF(Sender: TObject);
  end;

...

procedure TForm1.Button1Click(Sender: TObject);
var
  GIF: TGIFImage;
begin
  GIF := TGIFImage.Create;
  FBitmap := TBitmap.Create;
  Button1.Enabled := False;
  try
    GIF.LoadFromFile('c:\test\test.gif');
    GIF.DrawOptions := GIF.DrawOptions - [goLoop, goLoopContinously, goAsync];
    GIF.AnimationSpeed := 1000; // Max - no delay
    FBitmap.Width := GIF.Width;
    FBitmap.Height := GIF.Height;
    GIF.OnAfterPaint := AfterPaintGIF;

    ProgressBar1.Max := Gif.Images.Count;
    ProgressBar1.Position := 0;
    ProgressBar1.Smooth := True;
    ProgressBar1.Step := 1;

    // Paint the GIF onto FBitmap, Let TGIFPainter do the painting logic
    // AfterPaintGIF will fire for each Frame
    GIF.Paint(FBitmap.Canvas, FBitmap.Canvas.ClipRect, GIF.DrawOptions);
    ShowMessage('Done!');
  finally
    FBitmap.Free;
    GIF.Free;
    Button1.Enabled := True;
  end;
end;

procedure TForm1.AfterPaintGIF(Sender: TObject);
begin
  if not (Sender is TGIFPainter) then Exit;
  if not Assigned(FBitmap) then Exit;
  // The event will ignore Empty frames      
  FBitmap.Canvas.Lock;
  try
    FBitmap.SaveToFile(Format('%.2d.bmp', [TGIFPainter(Sender).ActiveImage]));
  finally
    FBitmap.Canvas.Unlock;
  end;
  ProgressBar1.StepIt;
end;

Note: No error handling to simplify the code.

---

---

EDIT: For newer versions of Delphi with build-in GIFImg unit, you can do this quit easy with the use of TGIFRenderer (which completely replaced old TGIFPainter) e.g.:

procedure TForm1.Button1Click(Sender: TObject);
var
  GIF: TGIFImage;
  Bitmap: TBitmap;
  I: Integer;
  GR: TGIFRenderer;
begin
  GIF := TGIFImage.Create;      
  Bitmap := TBitmap.Create;
  try
    GIF.LoadFromFile('c:\test\test.gif');
    Bitmap.SetSize(GIF.Width, GIF.Height);
    GR := TGIFRenderer.Create(GIF);
    try
      for I := 0 to GIF.Images.Count - 1 do
      begin
        if GIF.Images[I].Empty then Break;
        GR.Draw(Bitmap.Canvas, Bitmap.Canvas.ClipRect);
        GR.NextFrame;
        Bitmap.SaveToFile(Format('%.2d.bmp', [I]));
      end;
    finally
      GR.Free;
    end;  
  finally
    GIF.Free;
    Bitmap.Free;
  end;
end;

Tested with Delphi 2009

这篇关于TGifImage透明度问题的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！