2012-04-27 10 views
7

Estoy usando TGifImage que se incluye con Delphi XE.TGifImage Transparency Issue

Lo que intento hacer es cargar un archivo GIF desde un archivo y extraer todos los marcos a un mapa de bits.

Esto es lo que he hecho hasta ahora:

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; 

El problema que estoy enfrentando es con alguna cuestión de la transparencia con una gran cantidad de diferentes Gif, y también problemas de tamaño.

Aquí están algunos mapas de bits de ejemplo que se han guardado usando mi código anterior:

enter image description here enter image description here

Como se puede ver, los resultados no son grandes, tienen problemas de tamaño y transparencia.

Sé que los archivos Gif en sí mismos no están dañados, porque puedo cargarlos a través de mi navegador web y se muestran correctamente sin falta.

¿Cómo puedo cargar un archivo GIF desde el archivo, asignar cada marco al mapa de bits sin perder ninguna calidad?

+2

descubrí la forma en cómo se realizan los fotogramas clave. Está determinado por 'GraphicControlExtension.Disposal' para cada fotograma (si está disponible). Significa lo que el marco actual debería hacer con el búfer ya renderizado. Como fuente puedes usar algo más que 'TGIFRenderer', la clase que realmente renderiza las animaciones. Trataré de componer un ejemplo por la tarde (si alguien no fuera más rápido :-) Tengo que irme ahora ... – TLama

Respuesta

10

Para versiones anteriores de Delphi (Pre 2009): Tome un vistazo al código de GIFImage unidad, es posible que desee comprobar cómo TGIFPainter hace que las imágenes basadas en el método de cada cuadro Disposal.

He escrito un pequeño código que utiliza el controlador de eventos TGIFPainter.OnAfterPaint para guardar el marco activo en BMP, y hacer todo el "trabajo duro".

Nota: GIFImage versión de la unidad 2.2 de salida: 5 (23-MAYO-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; 

Nota: No manipulación para simplificar el código de error.

output bitmaps


Para las nuevas versiones de Delphi (2009+): Con construir-en GIFImg unidad, se puede hacer esto dejar de fumar fácil con el uso de TGIFRenderer (que sustituye completamente edad TGIFPainter), por ejemplo,:

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; 

El uso de 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; 
+1

Excelente, el segundo ejemplo funciona perfectamente para mí (Delphi XE). Ojalá pudiera aceptar múltiples respuestas en este escenario, gracias a todos. Estudiar este código lo hace parecer más fácil de lo que había anticipado. –

+5

+1, creo que usar el renderizador es la forma más natural de hacerlo. – TLama

2

Los marcos de un archivo GIF animado a menudo solo contienen las diferencias del cuadro anterior (una técnica de optimización para reducir el tamaño del archivo). Entonces, para producir una instantánea del GIF en un punto en particular, tendrás que pegar todos los marcos hasta ese punto, uno después del otro.

Podemos lograr esto mediante el uso Draw() con su 'dibujar con transparencia' conjunto de opciones:

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: Existen otros elementos al formato GIF animados, que especifican la cantidad de cuadros veces han de repetirse etc. pero pueden no preocuparte.

+0

Olvidé mencionar que ya lo intenté, no hubo diferencia. Parece que algunos marcos en un gif solo dibujan los bits adicionales, y utilizan marcos anteriores para dibujar el fondo. –

+0

Ok, he modificado mi respuesta :-) –

+0

¡Estaba realmente cerca de mi último comentario! No estoy seguro de cómo podría lograr esto sin embargo? –