TGifImage Transparency Issue

Question

Я использую TGifImage, который входит в состав Delphi XE.

Что я пытаюсь сделать, это загрузить Gif из файла и извлечь все рамы в растровое изображение.

Это то, что я сделал до сих пор:

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; 

Проблемы я столкнулся с некоторым вопросом прозрачности с большим количеством различного ГИФСА, а также размером проблемой.

Вот некоторые примеры растровых изображений, которые были сохранены с помощью моего кода выше:

Как вы можете видеть, что результаты не являются большими, они имеют проблемы размера и прозрачности.

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

Как загрузить Gif из файла, назначить каждому кадру Bitmap без потери качества?

Answer 1

Для более старых версий Delphi (Pre 2009): Посмотрите на код GIFImage блока, вы можете проверить, как TGIFPainter делает изображения на основе метода Disposal каждого кадра.

Я написал небольшой код, используя обработчик события TGIFPainter.OnAfterPaint, чтобы сохранить активный кадр в BMP и выполнить всю «тяжелую работу».

Примечание: GIFImage блок версии 2.2 Release: 5 (23-MAY-1999)

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; 

Примечание: Нет обработки для упрощения кода ошибки.

---

Для более новых версий 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:\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; 

---

Использование 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; 

Answer 2

Кадры анимированного GIF-файла часто содержат только отличия от предыдущего кадра (метод оптимизации для уменьшения размера файла). Поэтому, чтобы создать моментальный снимок GIF в определенном месте, вам придется вставлять все фреймы до этой точки один за другим.

Мы можем добиться этого с помощью Draw() с его «рисовать прозрачно» набор опций:

procedure ExtractGifFrames(FileName: string); 
var 
    Gif: TGifImage; 
    Bmp: TBitmap; 
    i: Integer; 
    Bounds: TRect; 
begin 
    Gif := TGifImage.Create; 
    try 
    Gif.LoadFromFile(FileName); 
    Bounds := Rect(0, 0, Gif.Width-1, Gif.Height-1); 

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

     for i := 0 to Gif.Images.Count - 1 do 
     begin 
     if not Gif.Images[i].Empty then 
     begin 
      Gif.Images[i].Draw(Bmp.Canvas, Bounds, True, True); 
      Bmp.SaveToFile(IntToStr(i) + '.bmp'); 
     end; 
     end; 
    finally 
     Bmp.Free; 
    end; 
    finally 
    Gif.Free; 
    end; 
end; 

NB: Есть и другие элементы в анимационном формате GIF, которые определяют количество раз кадров повторяться и т. д., но они могут не касаться вас.