德尔福 – TGifImage透明度问题

我用TGIFPainter.OnAfterPaint事件处理程序编写了一个小代码,将活动帧保存到BMP,并完成所有“辛勤工作”.

注：GIFImage单元版本2.2发布：5(1999年5月23日)

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:testtest.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;

注意：没有错误处理来简化代码.

对于较新的Delphi版本(2009)：使用内置GIFImg单元,您可以使用TGIFRenderer(完全替换旧的TGIFPainter)轻松退出,例如：

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:testtest.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;

使用GDI：

uses ...,GDIPAPI,GDIPOBJ,GDIPUTIL;

procedure ExtractGifFrames(const FileName: string);
var
  GPImage: TGPImage;
  encoderClsid: TGUID;
  BmpFrame: TBitmap;
  MemStream: TMemoryStream;
  FrameCount,FrameIndex: Integer;
begin
  GPImage := TGPImage.Create(FileName);
  try
    if GPImage.GetLastStatus = Ok then
    begin
      GetEncoderClsid('image/bmp',encoderClsid);
      FrameCount := GPImage.GetFrameCount(GDIPAPI.FrameDimensionTime);
      for FrameIndex := 0 to FrameCount - 1 do
      begin
        GPImage.SelectActiveFrame(GDIPAPI.FrameDimensionTime,FrameIndex);
        MemStream := TMemoryStream.Create;
        try
          if GPImage.Save(TStreamAdapter.Create(MemStream),encoderClsid) = Ok then
          begin
            MemStream.Position := 0;
            BmpFrame := TBitmap.Create;
            try
              BmpFrame.LoadFromStream(MemStream);
              BmpFrame.SaveToFile(Format('%.2d.bmp',[FrameIndex]));
            finally
              BmpFrame.Free;
            end;
          end;
        finally
          MemStream.Free;
        end;
      end;
    end;
  finally
    GPImage.Free;
  end;
end;