21 respuestas en este tema

[escafandra]

El formato gráfico GIF es de sobra conocido. Puede albergar varias imágenes y soportar pequeñas animaciones. Es un formato comprimido basado en el algoritmo LZW sin pérdida de calidad pero sólo hasta 256 colores.

Gif es un verdadero protocolo de transmisión de gráficos o un formato de archivo orientado a stream soportando entrelazado.

Todo archivo Gif comienza con una cabecera identificadora, con una firma (GIF 87a  ó GIF 89a) y los datos del descriptor de pantalla. Seguidamente pero opcional, tendríamos la paleta global y los datos de las imágenes. Los datos se empaquetan en bloques de longitud máxima 255 bytes. Cada bloque tiene una estructura idéntica que comienza con un Byte en el que se guarda el tamaño de los datos que lo siguen. Existen Extensiones adicionales que no son de imagen propiamente dicha como Graphic Control Extension, Comment Extension, Plain Text Extensión y Application Extension.

Cada extensión comienza con un Byte identificador de extensión (carácter '!'), un byte de firma o tipo de extensión, los datos en bloques (con el formato antes descrito) y un bloque terminador nulo (un Byte 0). Más información aquí.

Publico una clase que he escrito para el manejo de los archivos GIF escrita en C++ y en delphi. Dicha clase reúne casi todas las especificaciones GIF 89a y una Extensión de aplicación que permite el Loop de las imágenes (NETSCAPE 2.0). De forma que podremos visualizar o crear pequeñas animaciones GIF.

Las funciones básicas de la clase son:

Constructor por defecto, desde Un archivo o desde un Bitmap
LoadFromFile:  Carga un archivo
LoadFromStream: Carga un Gif desde un Stream que porta una imagen de archivo.
SaveToFile:  Guarda un archive.
IsOk:  True si el gif no causó errores.
GetBitmapCount:  Obtiene el número de imágenes de un Gif
IsFormat:  Estudia si un archivo tiene cabecera Gif válida
GetBitmap:  Devuelve un Bitmap según un índice
GetGraphicBlock:  Devuelve un puntero a una estructura Gráfica (TGraphicBlock)
AddGraphicBlock:  Añade un TGraphicBlock a la lista del Gif
SetGraphicBlock
InsertGraphicBlock
DeleteGraphicBlock

En la versión Builder C++ tenemos el operador:
operator Graphics::TBitmap*(); Con el que conseguimos el casting a la primera imagen almacenada.

La clase guarda una lista de TGraphicBlock. Cada uno guarda una imagen y datos adicionales de la misma. Esos datos se utilizaran para realizar nuestro visor gif. De ellos Bitmap representa la imagen o fotograma actual y  DelayTime el tiempo que se mostrará esa imagen:
 

delphi

TGraphicBlock = record
  Bitmap:                TBitmap; // La Imagen
  Method:                BYTE;    // Método de borrado de la Imagen:
                                  //  0: Sin acción específica
                                  //  1: No se quita la imagen
                                  //  2: Se restaura al color de fondo
                                  //  3: Se restaura al estado previo el área sobrescrita
  UserInput:             BYTE;    // bool
  DelayTime:             WORD;    // Tiempo de retardo para cambiar la Imagen
  Transparency:          BYTE;    // bool
  TransparentColorIndex: BYTE;
  Left:                  DWORD;   // Posición del Bitmap en la Ventana gráfica
  Top:                   DWORD;
end; PGraphicBlock = ^TGraphicBlock;

cpp

struct TGraphicBlock{
  Graphics::TBitmap* Bitmap;      // La Imagen
  BYTE               Method;      // Método de borrado de la Imagen:
                                  //  0: Sin acción específica
                                  //  1: No se quita la imagen
                                  //  2: Se restaura al color de fondo
                                  //  3: Se restaura al estado previo el área sobrescrita
  BYTE              UserInput;    // bool
  WORD              DelayTime;    // Tiempo de retardo para cambiar la Imagen
  BYTE              Transparency; // bool
  BYTE              TransparentColorIndex;
  DWORD             Left;         // Posición del Bitmap en la Ventana gráfica
  DWORD             Top;
};

Miembros importantes de la clase son:

Interlace:  Indica si la imagen es entrelazada
Loop:        Indica si las imágenes harán un loop al reproducirlas.
BackgroundColor: El color de fondo
Comments:  Un TStringList con una lista de cadenas con los comentarios del GIF (Extensiones de comentario).

Como ejemplo de utilización, publico dos aplicaciones:
1.- Una pequeña aplicación para visualizar y guardar imágenes en formato GIF sin animación.
2.- Otra aplicación que visualiza animaciones GIF. Como ejemplo, esta aplicación guarda un gif en un archivo mediante una lista de fotogramas de un Gif previamente leído. Es un simple ejemplo de como crear un gif animado desde bitmaps.
Los ejemplos son tremendamente sencillos, pero se pueden complicar un poco más para crear una pequeña aplicación que nos permita crear nuestras propias animaciones GIF


Espero que este código sea de utilidad para las aplicaciones tanto delphi como Builder o al menos aclare algo sobre el formato Gif.
 
 
¡ATENCIÓN!      La clase ha sido revisada y actualizada para las versiones delphi + berlin, Builder + Berlin y Lazarus v1.8.4. Los enlaces de estas versiones los tenéis aquí: TGif V 3.2 y TGif V 3.3
 
Nueva actualización que añade LoadFromStream aquí: TGIF V 3.5

 



Saludos.

Archivos adjuntos

•  1161_d873d274c187ea23f2b5c680f903438116d90a6f.zip   428,51KB   29 descargas
•  1162_ef45b5e2fa6bda04c89d6335d7caa8a97fa5e96d.zip   60,96KB   29 descargas
•  1160_f39edbeb4f4e107a10c7b9aef26cb6ec981cfbe0.zip   423,64KB   38 descargas

[enecumene]

:-#, ¡¡ excelente aporte amigo !! , muchas gracias escafandra.

[egostar]

Muchas gracias amigo escafandra, siempre interesantes tus aportaciones

Salud OS

[escafandra]

Muchas gracias a vosotros por el intereis que mostrais. 

Saludos.

[Caral]

Hola
Que bueno, muy interesante, lo voy a tratar de probar.
Muchas gracias por el aporte.
Saludos

[seoane]

Impresionante 

[Delphius]

Me dejas con los ojos abiertos y pequeñito de la envidia, ¿hay algo que no sepas ?

¡Gracias por compartir tus conocimientos y tus habilidades!

Saludos,

[escafandra]

...Que bueno, muy interesante, lo voy a tratar de probar. ...

No lo dudes, si sigues bien los ejemplos verás que es fácil e intuitivo. No dejes de exponer tus pegas o de descubrir algún bug.

Impresionante 

Gracias a tí maestro.

¿hay algo que no sepas ?

Me queda casi todo por saber, amigo.



Gracias a todos vosotros. 

Saludos.

[escafandra]

La clase TGif ha sido actualizada con motivo de la realización de un componente visualizador de Este tipo de gráficos y animaciones. La actualización básicamente mejora el problema de las transparencias en las imágenes Gif y arregla un bug en el color de fondo de las mismas.

La nueva versión de TGif, tanto para C/C++ como para delphi se encuentra en este hilo.

Saludos.

[creedelcam]

Hola Escafandra,
Estoy trabajando en C++ Builder 6 con imagenes. Mi problema es que cuando agrego un "Image" a mi proyecto e intento cargar una imagen de tipo *.gif, a traves de la propiedad "Picture" no lo consigo pues dicho formato no lo reconoce (unicamente puedo escoger entre archivos *.jpg, *.bmp, *.ico, entre otros), favor indicarme que debo hacer.
Tengo el Borland C++ Builder version 6.0 (Build 10.160) he visto que otros usuarios pueden hacerlo con la misma version, por favor ayudenme,
saludos!

[escafandra]

Bienvenido al foro, creedelcam.

La clase que expongo, no permite trabajar directamente como quieres. No se deriva de nada que conozcas de la VCL, pero tiene procedimientos para compatibilizarse con ella. Seguro que lo que te permitirá cargar un gif y luego convertirlo a un TBitmap. Baja los adjuntos de ejemplo.

En concreto mira este código:
 

cpp

// Leer un gif de un archivo y asignarlo a un TImage
TGIF gif;
gif.LoadFromFile(OpenDialog1->FileName);
Image1->Picture->Bitmap->Assign(gif);

cpp

// Guardar la imagen de un TImage en formato Gif
TGIF Gif(Image1->Picture->Bitmap);
Gif.SaveToFile(SaveDialog1->FileName);

Si descargas el código adjunto, encontrarás mas utilidades de la clase, incluso animaciones Gif.

Por otro lado, puedes descargarte un componente, TGifViewer que escribí para crear rápidamente un visor de gráficos GIF. Aquí encontrarás una actualización de la clase TGif y un programa de ejemplo que te demostrará cómo utilizar ese componente.

Seguro que te resulta de utilidad.

Saludos.

[cHackAll]

Muy interesante escafandra!, con tu permiso comparto un ejemplo utilizando APIs;

delphi

// . . .
 
   repeat
    hCanvas := GetDC(hDlg);
    GdipCreateFromHDC(hCanvas, hGraphics);
    GdipFillRectangleI(hGraphics, hBrush, Rect.Top, Rect.Left, Rect.Right, Rect.Bottom);
    GdipDrawImageRectI(hGraphics, hImage, Rect.Top, Rect.Left, Rect.Right, Rect.Bottom);
    GdipDeleteGraphics(hGraphics);
    ReleaseDC(hDlg, hCanvas);
    if Frames > 1 then
     begin
      GdipImageSelectActiveFrame(hImage, FrameDimensionTime, Index);
      Index := (Index + 1) mod Frames;
     end;
    Sleep(Elapse[Index] * 10);
   until not IsWindow(hDlg);
 
// . . .

Saludos

Archivos adjuntos

•  2153_4bcff1fe341129218d19add94a2a212333351910.zip   6,05KB   11 descargas

[escafandra]

Muy interesante escafandra!, con tu permiso comparto un ejemplo utilizando APIs;

Por supuesto, amigo....

...mmm GDIplus 

El código de la clase que publique lo escribí bastante antes de que apareciera GDIplus, en los tiempos del DOS. Lo actualicé con motivo de este hilo pues me pareció muy instructivo.
El uso de la API del GDIplus lo hace mucho mas sencillo pero más anónimo y menos portable.

En cualquier caso es inhabitable echar mano del GDIplus con el cual he jugado con provecho.



Saludos.

[escafandra]

...Y ahora también en Lazarus

Pues descargué e instale Lazarus y para empezar a jugar y a raíz de un hilo, adapté la  Clase TGif a este entorno.

La funcionalidad de clase es la misma que las versiones para delphi y C/C++, recordar que además proporcionar soporte para de  visualizar imágenes Gif estáticas, lo hace también para animaciones. Puede guardar archivos gif y proporciona soporte para crear  nuestras propias animaciones.

He encontrado algún contratiempo al trabajar con TBitmaps en Lazarus. En un principio pensé que sería similar a delphi o Builder  pero me topé con un impedimento a la hora de usar TBitmap.ScanLine pués, no existe. Parece ser que se debe a la incompatibilidad  con los Device Independent Bitmap de Windows. Así que tuve que escribir una clase para conseguir suplantar esa funcionalidad a una  velocidad aceptable. Dicha clase, TBitmapStream se deriva de TMemoryStream y básicamente se trata de un mapa en memoria de un  fichero .bmp.

Espero que sea de utilidad para, los cada vez mas numerosos, amantes de Lazarus.

Saludos.

PD: Por un problema puntual, no puedo subir los adjuntos por el momento.

[escafandra]

Por problemas para subir archivos, publico el código completo:

delphi

{*******************************************************************************
 
  Objetivo  : CARGA, DESCOMPRESION Y COMPRESIÓN DE FICHEROS GIF.
  Autor      : escafandra 2011.
  Compilador : Lazarus
 
*******************************************************************************}
 
unit Gif;
 
{$MODE Delphi}
 
interface
uses
  Windows, Classes, Graphics, IntfGraphics, SysUtils, Math;
 
const  NO_CODE    =  -1;
const  GIFSIG    =  'GIF89a';
const  LARGESTCODE = 4095;
const  TABLESIZE  = 5003;
const  NLIN        = 10;    //Numero de lineas procesadas para informar del progreso
 
// Líneas de comienzo del entrelazado 4 pasadas:
StarTable: array[0..3] of WORD  = (0, 4, 2, 1);
// Incrementos del entrelazado para cada línea de comienzo (líneas siguientes):
IncTable:  array[0..3] of WORD  = (8, 8, 4, 2);
 
wordmasktable: array[0..15] of WORD =
              ($0000, $0001, $0003, $0007,
              $000F, $001F, $003F, $007F,
              $00FF, $01FF, $03FF, $07FF,
              $0FFF, $1FFF, $3FFF, $7FFF);
 
type
 
{$ALIGN 1}
 
GIFHEADER = record
  // Header 3 BYTES:  "GIF"
  // Version 3 BYTES: "87a", "89a"
  signature: array[0..5] of CHAR;  // GIF87a ó GIF89a
 
  // Logical Screen Descriptor:
  ScreenWidth, ScreenHeight: WORD;
  flags, background, aspect: BYTE;
end;  PGIFHEADER = ^GIFHEADER;
 
IMAGEBLOCK = record
  Introducer:BYTE ; //',' 
  left, top, width, height: WORD;
  flags: BYTE;
end; PIMAGEBLOCK = ^IMAGEBLOCK;
 
GRAPHIC_CONTROL_EXTENSION = record
  Introducer, Label_E, BlockSize, flags: BYTE;
  DelayTime: WORD;
  TransparentColorIndex, Terminator: BYTE;
end; PGRAPHIC_CONTROL_EXTENSION = ^GRAPHIC_CONTROL_EXTENSION;
 
NETSCAPE_EXTENSION = record
  Introducer:            BYTE;  // '!'
  Label_E:                BYTE;  // 0xFF
  BlockSize:              BYTE;  // 11
  AppId:  array[0..7] of CHAR;  // "NETSCAPE"
  AppCode: array[0..2] of CHAR;  // "2.0"
  SubBlockSize:          BYTE;  // 3
  Data1:                  BYTE;  // 1
  LoopIterator:          WORD;  // 0
  Terminator:            BYTE;  // 0
end; PNETSCAPE_EXTENSION = ^NETSCAPE_EXTENSION;
 
COMMENT_EXTENSION_HEADER = record
  Introducer: BYTE;              // '!'
  Label_E:    BYTE;              // 0xFE
  BlockSize:  BYTE;              //
  Comment: array[0..0] of CHAR;  // Cadena de comentario ASCII/Z
end; PCOMMENT_EXTENSION_HEADER = ^COMMENT_EXTENSION_HEADER;
 
{$ALIGN OFF}
 
TGraphicBlock = record
  Bitmap:                TBitmap;  // La Imagen
  Method:                BYTE;    // Metodo de borrado de la Imagen:
                                  //  1: Sin accion espec´´ifica
                                  //  2: No se quita la imagen
                                  //  3: Se restaura al color de fondo
                                  //  4: Se restaura al estado previo el area sobreescrita
  UserInput:            BYTE;    // bool
  DelayTime:            WORD;    // Tiempo de retardo para cambiar la Imagen
  Transparency:          BYTE;    // bool
  TransparentColorIndex: BYTE;
  Left:                  DWORD;    // Posición del Bitmap en la Ventana gráfica
  Top:                  DWORD;
end; PGraphicBlock = ^TGraphicBlock;
 
TRGBTable = record
  Red:  BYTE;
  Green: BYTE;
  Blue:  BYTE;
end; PRGBTable = ^TRGBTable;
TRGBArray = array[0..0] of TRGBTable;
PRGBArray = ^TRGBArray;
 
BMPFILEHEADER = record
 
  // Un fichero.bmp comienza con una cabeceraBMP como esta.
  // Sigue con la paleta indexada en RGB, justo detras de la cabecera.
  // Termina con la imagen en mapa de bits comenzando de abajo a arriba.
  // Si el mapa es de 24 bits no se guarda la paleta
 
  Signature:      WORD;    // BM  4D42
  SizeFile:      DWORD;  // Tamaño del fichero.bmp
  Reserved1:      WORD;    // Reservado, debe ser cero
  Reserved2:      WORD;    // Reservado, debe ser cero
  OffBits:        DWORD;  // Desplazamiento del comienzo de la imagen
  SizeOfBMIH:    DWORD;  // Tamaño de BITMAPINFOHEADER, debe ser 40
  Width:          DWORD;  // Nº Maximo de Columnas
  Height:        DWORD;  // Nº Maximo de Filas
  BitPlanes:      WORD;    // Nº Planos de bit debe ser 1
  BitCount:      WORD;    // Nº de bits por pixel (1, 4, 8, o 24)
  Compression:    DWORD;  // Tipo de compresion (0=none, 1=RLE-8, 2=RLE-4)
  SizeImage:      DWORD;  // Tamaño de la imagen en bytes (padding incluido)
  XPelsPerMeter:  DWORD;  // Resolucion horizontal en pixels por metro (unreliable)
  YPelsPerMeter:  DWORD;  // Resolucion vertical en pixels por metro (unreliable)
  ClrUsed:        DWORD;  // Numero de colores de la imagen, o cero
  ClrImportant:  DWORD;  // Numero de colores importantes, o cero
  Palette:        DWORD;
end;
PBMPFILEHEADER = ^BMPFILEHEADER;
 
 
TBitmapStream = class (TMemoryStream)
  public
  constructor Create();
  constructor CreateFromData(Width, Height, BitCount: integer);
 
  function  GetWidth(): LONG;
  function  GetHeight(): LONG;
  function  GetBitCount(): WORD;
  function  GetBits(): Pointer;
  function  GetPalette(): Pointer;
  function  ScanLine(Line: DWORD): Pointer;
  procedure GetRGBTableColors(Colors: PBYTE);
  procedure SetRGBTableColors(Colors: PBYTE);
  procedure InitFromData(Width, Height, BitCount: DWORD);
end;
 
 
////////////////////////////////////////////////////////////////////////////////
// Definicion de la clase manejadora de ficheros GIF.
////////////////////////////////////////////////////////////////////////////////
TGIF = class
  public
  Interlace:  boolean;      // Indica si la imagen es entrelazada
  Loop:        boolean;      // Indica si las imagenes harán un loop al reproducirlas.
  BackgroundColor: TColor;  // Color de fondo
  Comments:    TStringList;
 
  constructor  Create;
  constructor  CreateFromBitmap(Bitmap: TBitmap);
  constructor  CreateFromFile(const FileName: String);
  destructor  Destroy; override;
 
  procedure    LoadFromFile(FileName: String);
  function    LoadFromBitmap(Bitmap: TBitmap): boolean;
  procedure    SaveToFile(FileName: String);
  function    Load(const FileName: String): boolean;  // Carga un GIF.
  function    Write(const FileName: String): boolean; // Escribe un GIF.
  function    GetBitmapCount(): integer;              // Devuelve el nº de imagenes en lista
  function    IsOk(): boolean;                        //
  function    IsFormat(const FileName: String): boolean; // consulta la cabecera GIF de un archivo
  function    GetBitmap(n: integer = 0): TBitmap;    // Devuelve la imagen n de la lista
  function    GetGraphicBlock(n: integer): PGraphicBlock;
  procedure    AddGraphicBlock(GB: TGraphicBlock);
  procedure    SetGraphicBlock(n: integer; GB: PGraphicBlock);
  procedure    InsertGraphicBlock(n: integer; GB: PGraphicBlock);
  procedure    DeleteGraphicBlock(n: integer);
 
  protected
  FBmpStream:  TBitmapStream;
  FBitmap:    TBitmap;  // TBitmap con la imegen actualmente leida
  FListBitmap: TList;
  DefPalette:  array of TRGBTable; // PRGBArray;
  DefNColors:  integer;
 
  function    UnpackGif(): boolean;  // Desempaqueta la imagen
  function    SkipExtension(Offset: LongInt): LongInt; // Salta una extension
 
  function    UnZipImage(pGifLZW: PBYTE; bits, width, height, flags: integer): LongInt;
 
  function    WriteGif(hFile: integer): LongInt;
  function    WriteGifHeader(hFile: integer): LongInt;
  function    WriteIBlockHeader(hFile: integer; GBlock: PGraphicBlock): LongInt;
  function    WriteImage(hFile: integer; GBlock: PGraphicBlock): LongInt;
  function    Flush(hFile: integer; N: BYTE): LongInt;
  function    WriteCode(hFile: integer; Code: integer): LongInt;
 
  function    ZipImage(hFile: integer; Bitmap: TBitmap): LongInt;
  function    WriteLoopNetscape(hFile: integer): LongInt;
  function    WriteComment(hFile: integer; Comment: PCHAR): LongInt;
  function    GetCommentExtension(Offset: LongInt): LongInt;
  function    CmpPalette(Palette: pointer; nColors: integer): boolean;
  procedure    InitTable(MinCodeSize: integer);
 
  private
  Ok:          boolean;
 
  // Datos de lectura:
  GifBuffer:  PBYTE;    // Buffer que contiene todo el fichero GIF leido
  GifBufferSize: DWORD;  // Tamaño del archivo.gif leido
 
  // Datos de escritura:
  OldCode:    array of WORD; // PAWord;
  CurrentCode: array of WORD; //PAWord;
  NewCode:    array of BYTE; //PAByte;
  CodeBuffer:  array of BYTE; //PAByte;
 
  CodeSize:    WORD;
  ClearCode:  WORD;
  EofCode:    WORD;
  BitOffset:  DWORD;
  ByteOffset:  DWORD;
  BitsLeft:    DWORD;
  MaxCode:    WORD;
  FreeCode:    WORD;
 
  procedure    BuildWBuffers();
  procedure    ClearListBitmap();
end;
 
//---------------------------------------------------------------------------
 
const
nl: NETSCAPE_EXTENSION = (Introducer: BYTE('!'); Label_E: $FF; BlockSize: 11;
                          AppId: 'NETSCAPE'; AppCode: '2.0'; SubBlockSize: 3;
                          Data1: 1; LoopIterator: 0; Terminator: 0);
 
 
implementation
 
 
//------------------------------------------------------------------------------
constructor TBitmapStream.Create();
begin
  inherited Create;
end;
 
constructor TBitmapStream.CreateFromData(Width, Height, BitCount: integer);
begin
  inherited Create;
  InitFromData(Width, Height, BitCount);
end;
 
procedure TBitmapStream.InitFromData(Width, Height, BitCount: DWORD);
var
  SizeImage, ColorCount, SizeFile: DWORD;
begin
  Clear;
  if BitCount <=  4 then BitCount:=  4
  else if BitCount <=  8 then BitCount:=  8
  else if BitCount <= 15 then BitCount:= 15
  else if BitCount <= 16 then BitCount:= 16
  else if BitCount <= 24 then BitCount:= 24
  else if BitCount <= 32 then BitCount:= 32;
 
  SizeImage:= ((Width * BitCount + 31) div 32) * 4 * Height;
  ColorCount:= (1 shl BitCount);
  SizeFile:= sizeof(BMPFILEHEADER) + (ColorCount-1) * 4 + SizeImage;
  SetSize(SizeFile);
 
//  FillChar(Memory^, sizeof(BMPFILEHEADER), 0);
  PBMPFILEHEADER(Memory)^.Signature:= $4D42; // 'BM'
  PBMPFILEHEADER(Memory)^.SizeFile:= SizeFile;
  PBMPFILEHEADER(Memory)^.Width:= Width;
  PBMPFILEHEADER(Memory)^.Height:= Height;
  PBMPFILEHEADER(Memory)^.BitCount:= BitCount;
  PBMPFILEHEADER(Memory)^.OffBits:= sizeof(BMPFILEHEADER) + (ColorCount-1) * 4;
  PBMPFILEHEADER(Memory)^.SizeOfBMIH:= 40;
  PBMPFILEHEADER(Memory)^.SizeImage:= SizeImage;
  PBMPFILEHEADER(Memory)^.ClrUsed:= ColorCount;
  PBMPFILEHEADER(Memory)^.ClrImportant:= 0;  // ColorCount;
  PBMPFILEHEADER(Memory)^.Reserved1:= 0;      // Reservado, debe ser cero
  PBMPFILEHEADER(Memory)^.Reserved2:= 0;      // Reservado, debe ser cero
  PBMPFILEHEADER(Memory)^.BitPlanes:= 1;
  PBMPFILEHEADER(Memory)^.Compression:= 0;    // Tipo de compresion (0=none, 1=RLE-8, 2=RLE-4)
  PBMPFILEHEADER(Memory)^.XPelsPerMeter:= 0;  // Resolucion horizontal en pixels por metro (unreliable)
  PBMPFILEHEADER(Memory)^.YPelsPerMeter:= 0;  // Resolucion vertical en pixels por metro (unreliable)
end;
 
procedure TBitmapStream.GetRGBTableColors(Colors: PBYTE);
var
  i, nColors: cardinal;
  Palette: PBYTE;
begin
  Palette:= GetPalette;
  if (GetBitCount < 24) and (Colors <> nil) then
  begin
    nColors := (1 shl GetBitCount);
    for i:=0 to nColors - 1 do
    begin
      (Colors + 2)^:= (Palette + 0)^;    // Blue
      (Colors + 1)^:= (Palette + 1)^;    // Green
      (Colors + 0)^:= (Palette + 2)^;    // Red
      inc(Palette, 4);
      inc(Colors, 3);
    end;
  end;
end;
 
procedure TBitmapStream.SetRGBTableColors(Colors: PBYTE);
var
  i, nColors: cardinal;
  Palette: PBYTE;
begin
  Palette:= GetPalette;
  if (GetBitCount < 24) and (Colors <> nil) then
  begin
    nColors := (1 shl GetBitCount);
    for i:=0 to nColors - 1 do
    begin
      (Palette + 0)^ := (Colors + 2)^;    // Blue
      (Palette + 1)^ := (Colors + 1)^;    // Green
      (Palette + 2)^ := (Colors + 0)^;    // Red
      (Palette + 3)^ := 0;
      inc(Palette, 4);
      inc(Colors, 3);
    end;
  end;
end;
 
function TBitmapStream.GetBitCount(): WORD;
begin
  Result := PBMPFILEHEADER(Memory)^.BitCount;
end;
 
function TBitmapStream.GetWidth(): LONG;
begin
//  Result:= PLONG(Memory+18)^;
  Result:= PBMPFILEHEADER(Memory)^.Width;
end;
 
function TBitmapStream.GetHeight(): LONG;
begin
//  Result:= PLONG(Memory+22)^;
  Result:= PBMPFILEHEADER(Memory)^.Height;
end;
 
function TBitmapStream.GetPalette(): Pointer;
begin
  Result:= Memory + sizeof(BMPFILEHEADER) - 4;
end;
 
function TBitmapStream.GetBits(): Pointer;
begin
//  Result:= Memory + PDWORD(Memory+10)^;
  Result:= Memory + PBMPFILEHEADER(Memory)^.OffBits;
end;
 
function  TBitmapStream.ScanLine(Line: DWORD): Pointer;
var
  SizeLine: DWORD;
begin
  SizeLine:= ((GetWidth * GetBitCount + 31) div 32) * 4;
  Result:= Memory + PBMPFILEHEADER(Memory)^.OffBits + (int64(GetHeight) - 1 - Line) * SizeLine;
end;
 
//------------------------------------------------------------------------------
//  El constructor por defecto.
constructor TGIF.Create;
begin
  FListBitmap:= TList.Create;
  FBitmap:= TBitmap.Create;
  FBmpStream:= TBitmapStream.Create;
  Comments:= TStringList.Create;
end;
 
//------------------------------------------------------------------------------
//  El constructor desde un Bitmap
constructor TGIF.CreateFromBitmap(Bitmap: TBitmap);
begin
  FListBitmap:= TList.Create;
  FBmpStream:= TBitmapStream.Create;
  FBitmap:= TBitmap.Create;
  FBitmap.HandleType:= bmDIB; //bmDDB; //;
  Comments:= TStringList.Create;
  LoadFromBitmap(Bitmap);
end;
 
function TGIF.LoadFromBitmap(Bitmap: TBitmap): boolean;
var
  GB: TGraphicBlock;
begin
  Result:= false;
  if Bitmap.PixelFormat > pf8bit then exit;
  Interlace:= FALSE;
  Loop:= FALSE;
  Ok:= TRUE;
  FBitmap.Assign(Bitmap);
  //ZeroMemory(@GB, sizeof(TGraphicBlock));
  FillChar(GB, sizeof(TGraphicBlock), 0);
  GB.Bitmap:= FBitmap;
  AddGraphicBlock(GB);
end;
 
//------------------------------------------------------------------------------
//  El constructor desde un archivo
constructor TGIF.CreateFromFile(const FileName: string);
begin
  Interlace:= FALSE;
  Loop:= FALSE;
  Ok:= TRUE;
  FListBitmap:= TList.Create;
  FBitmap:= TBitmap.Create;
  FBmpStream:= TBitmapStream.Create;
  Comments:= TStringList.Create;
  if FileName <> '' then
    Ok:= Load(FileName);
end;
 
 
//------------------------------------------------------------------------------
//  El destructor.
destructor TGIF.Destroy;
begin
  ClearListBitmap;
  FListBitmap.Destroy;
  FBitmap.Destroy;
  FBmpStream.Destroy;
  Comments.Destroy;
end;
 
//------------------------------------------------------------------------------
// Vacía los fotogramas
procedure TGIF.ClearListBitmap();
var
  n:  integer;
  GB: PGraphicBlock;
begin
  for n:= 0 to FListBitmap.Count-1 do
  begin
      GB:= PGraphicBlock(FListBitmap.Items[n]);
      GB.Bitmap.Destroy;
      FreeMem(GB);
  end;
  FListBitmap.Clear;
end;
 
//------------------------------------------------------------------------------
// Carga un GIF.
procedure TGIF.LoadFromFile(FileName: String);
begin
  Load(FileName);
end;
 
//------------------------------------------------------------------------------
// Guarda un GIF.
procedure TGIF.SaveToFile(FileName: String);
begin
  Write(FileName);
end;
 
//------------------------------------------------------------------------------
// Carga un GIF.
function TGIF.Load(const FileName: String): boolean;
var
  FileHandle : Integer;
begin
  Loop:= FALSE;
  Ok:= FALSE;
  ClearListBitmap;
  Comments.Clear();
 
  FileHandle:= FileOpen(FileName, fmOpenRead {or fmShareDenyNone});
  if  FileHandle <> -1 then
  begin
    // Mira el tamaño del GIF.
    // Reserva memoria para el fichero.
    GifBufferSize := FileSeek(FileHandle,0,2);
    FileSeek(FileHandle,0,0);
    GifBuffer:= AllocMem(GifBufferSize);
    if FileRead(FileHandle, GifBuffer^, GifBufferSize) = integer(GifBufferSize) then
    begin
        Ok:= UnpackGif();
        if Ok <> TRUE then
          FreeMem(GifBuffer);
    end;
    FileClose(FileHandle);
  end;
  Result:= Ok;
end;
 
//------------------------------------------------------------------------------
// Escribe un GIF.
function TGIF.Write(const FileName: String): boolean;
var
  FileHandle : Integer;
begin
  Result:= FALSE;
  if FListBitmap <> nil then
  begin
    if FListBitmap.Count > 0 then
    begin
      FileHandle:= FileCreate(FileName);
      if  FileHandle <> -1 then
      begin
          WriteGif(FileHandle);
          FileClose(FileHandle);
          Result:= TRUE;
      end;
    end;
  end;
end;
 
//------------------------------------------------------------------------------
// Devuelve el nº de imagenes en lista
function TGIF.GetBitmapCount(): integer;
begin
  Result:= FListBitmap.Count; // Devuelve el nº de imagenes en lista
end;
 
//------------------------------------------------------------------------------
// Devuelve si tenemos cargado un archivo válido sin errores
function TGIF.IsOk(): boolean;
begin
  Result:= Ok;
end;
 
//------------------------------------------------------------------------------
// consulta la cabecera GIF de un archivo
function TGIF.IsFormat(const FileName: String): boolean;
var
  FileHandle : Integer;
  Cabecera:    GIFHEADER;
begin
  Result:= FALSE;
  FileHandle:= FileOpen(FileName, fmOpenRead or fmShareDenyNone);
  if (FileHandle <>-1) then
  begin
    FileRead(FileHandle, Cabecera, sizeof(Cabecera));
    FileClose(FileHandle);
    Result:= CompareMem(@Cabecera.signature[0], PCHAR(GIFSIG), 3);
  end;
end;
 
//------------------------------------------------------------------------------
// Devuelve la imagen n de la lista
function TGif.GetBitmap(n: integer = 0): TBitmap;
begin
  if Ok = TRUE then
      Result:= (PGraphicBlock(FListBitmap.Items[n])).Bitmap
  else
      Result:= FBitmap;
end;
 
//------------------------------------------------------------------------------
// Devuelve un Bloque gráfico n de la lista
function TGif.GetGraphicBlock(n: integer): PGraphicBlock;
begin
  Result:= PGraphicBlock(FListBitmap.Items[n]);
end;
 
//------------------------------------------------------------------------------
procedure TGif.AddGraphicBlock(GB: TGraphicBlock);
var
  pGB: PGraphicBlock;
begin
  GetMem(pGB, sizeof(TGraphicBlock));
  pGB^:= GB;
  pGB.Bitmap:= TBitmap.Create;
  pGB.Bitmap.Assign(GB.Bitmap);
  FListBitmap.Add(pGB);
end;
 
//------------------------------------------------------------------------------
procedure TGif.SetGraphicBlock(n: integer; GB: PGraphicBlock);
begin
  PGraphicBlock(FListBitmap.Items[n])^ := GB^;
  PGraphicBlock(FListBitmap.Items[n]).Bitmap.Assign(GB.Bitmap);
end;
 
//------------------------------------------------------------------------------
procedure TGif.InsertGraphicBlock(n: integer; GB: PGraphicBlock);
var
  Item: PGraphicBlock;
begin
  GetMem(Item, sizeof(TGraphicBlock));
  FListBitmap.Insert(n, Item);
  SetGraphicBlock(n, GB);
end;
 
//------------------------------------------------------------------------------
procedure TGif.DeleteGraphicBlock(n: integer);
begin
  PGraphicBlock(FListBitmap.Items[n]).Bitmap.Free;
  FListBitmap.Delete(n);
end;
 
//------------------------------------------------------------------------------
// Desempaqueta e interpreta un archivo GIF
function TGif.UnpackGif(): boolean;
var
  ReadOff: DWORD;
  gh: PGIFHEADER;
  iblk: PIMAGEBLOCK;
  GCE: PGRAPHIC_CONTROL_EXTENSION;
  NL: PNETSCAPE_EXTENSION;
  //CE: PCOMMENT_EXTENSION_HEADER;
  Palette: PBYTE;
  NumColors, BitCount, bits: integer;
  nUnzipBytes: DWORD;
  GB: TGraphicBlock;
  AGifBuffer: PCHAR;
begin
  Result:= FALSE;
  ReadOff:= 0;
  Palette:= nil;
  AGifBuffer:= PCHAR(GifBuffer);
 
  // Asegurarse de que es un Fichero GIF
  gh:= PGIFHEADER(GifBuffer);
  ReadOff:= ReadOff + sizeof(GIFHEADER);
 
  if CompareMem(@gh.signature[0], PCHAR(GIFSIG), 3) = TRUE then
  begin
    // Obtener las dimensiones de la pantalla
    bits:= (gh.flags and $0007)+1;
    BitCount:= (gh.flags and $0007)+1;
    // Obtener el mapa de colores si existe uno
    if (gh.flags and $80) = $80 then
    begin
      NumColors:= (1 shl BitCount);
      Palette:= GifBuffer + ReadOff;
      inc(ReadOff, 3*NumColors);
      // Obtener el Background Color
      BackgroundColor:= RGB((Palette + gh.background)^,
                            (Palette + gh.background+1)^,
                            (Palette + gh.background+2)^);
    end else BackgroundColor:= 0;
 
    // Step through the blocks
    // ZeroMemory(@GB, sizeof(TGraphicBlock));
    FillChar(GB, sizeof(TGraphicBlock), 0);
    while (AGifBuffer[ReadOff] = ',') or (AGifBuffer[ReadOff] = '!') or (AGifBuffer[ReadOff] = #0) do
    begin
      // si es un bloque de imagen
      if AGifBuffer[ReadOff] = ',' then
      begin
          // Obtener el comienzo del bloque de imagen
          iblk:= PIMAGEBLOCK(GifBuffer + ReadOff);
          inc(ReadOff, sizeof(IMAGEBLOCK));
          // Obtener el mapa local de colores si existe uno
          if (iblk.flags and $80) = $80 then
          begin
            NumColors:= 1 shl ((iblk.flags and $0007)+1);
            Palette:= GifBuffer + ReadOff;
            inc(ReadOff, 3*NumColors);
          end;
          // Obtener si es entrelazado
          Interlace:= ((iblk.flags and $40) = $40);
 
          // Obtener el tamaño del codigo inicial
          bits:= (GifBuffer + ReadOff)^;
          inc(ReadOff);
          if bits = BYTE(-1{EOF}) then
          begin
            Result:= FALSE;
            break;
          end;
 
          // Memoria para el dibujo descomprimido.
          if BitCount < 4 then BitCount:= 4;
          FBmpStream.InitFromData(iblk.width, iblk.height, BitCount);
 
          // Coloco la paleta
          FBmpStream.SetRGBTableColors(Palette);
 
          // Desempaqueta la imagen
          nUnzipBytes:= UnZipImage(GifBuffer+ReadOff, bits, iblk.width, iblk.height, iblk.flags);
          inc(ReadOff, nUnzipBytes);
          GB.Bitmap:= FBitmap;
          GB.Left  := iblk.left;
          GB.Top  := iblk.top;
          AddGraphicBlock(GB);
          if nUnzipBytes <> 0 then continue;
          Result:= TRUE;
          break;
      end
      // En otro caso es una extension
      else if AGifBuffer[ReadOff] = '!' then
      begin
        // ¿Es un Graphic Control Extension?
        if AGifBuffer[ReadOff+1] = CHAR($F9) then
        begin
          GCE:= PGRAPHIC_CONTROL_EXTENSION(GifBuffer + ReadOff);
          GB.Method:=      (GCE.flags shr 2) and 07;
          GB.UserInput:=  (GCE.flags shr 1) and 01;
          GB.Transparency:= GCE.flags and 01;
          GB.DelayTime:=    GCE.DelayTime;
          GB.TransparentColorIndex:= GCE.TransparentColorIndex;
        end;
        // ¿Es un NetscapeLoop?
        NL:= PNETSCAPE_EXTENSION(GifBuffer + ReadOff);
        Loop:= (Loop or CompareMem(NL, nl, sizeof(NETSCAPE_EXTENSION)-3));
 
        // ¿Es un comentario?
//        CE:= PCOMMENT_EXTENSION_HEADER(DWORD(GifBuffer) + ReadOff);
//        if CE.Label_E = $FE then
//          Comment:= String(CE.Comment, CE.BlockSize);
        GetCommentExtension(ReadOff);
 
        ReadOff:= SkipExtension(ReadOff);
      end;
    end;
  end;
  Result:= Ok;
end;
 
//------------------------------------------------------------------------------
// Salta una extension
function TGIF.SkipExtension(Offset: LongInt): LongInt;
var
  AGifBuffer: PCHAR;
  n: integer;
begin
  AGifBuffer:= PCHAR(GifBuffer);
  if AGifBuffer[Offset] = '!' then
  begin
    inc(Offset, 2);
    repeat
      n:= integer(AGifBuffer[Offset]);
      inc(Offset);
      if n <> (-1){EOF} then
        inc(Offset, n);
    until (n = 0) or (n = -1{EOF});
 
  end;
  Result:= Offset;
end;
 
//------------------------------------------------------------------------------
// Descomprime una Imagen Gif.
function TGIF.UnZipImage(pGifLZW: PBYTE; bits, width, height, flags: integer): LongInt;
var
  GifLZW: PBYTE;
  bits2: WORD;          // Bits plus 1
  codesize: integer;    // Current Code size in bits
  codesize2: integer;    // Next Code size
  nextcode: integer;    // Next babailable table entry
  thiscode: WORD;        // Code begin expanded
  oldtoken: integer;    // last simbol decoded
  currentcode: integer;  // Code just read
  oldcode: integer;      // Code read before this one
  bitsleft: integer;    // Number of bits left in *p
  blocksize: integer;    // Bytes in next block
  line: WORD;            // Nex line to write
  NexByte: WORD;        // Nex byte to write
  pass: WORD;            // Number of interlaced pictures
  p: PBYTE;              // Pointer to current byte in read buffer
  q: PBYTE;              // Pointer pass last byte in read buffer
  b: array [0..255]of BYTE;      // Read buffer
  u: PBYTE;                      // Stack pointer into firtscodestack
  linebuffer:  array of BYTE;    // Place to store the current line
  firtscodestack: array of BYTE; // Stack for firts code
  lastcodestack: array of BYTE;  // Stack for previous code
  codestack:  array of WORD;    // Stack for links
  LinePixels: PByteArray;
  X: integer;
  Error: boolean;
begin
  Error:= FALSE;
  GifLZW:= pGifLZW;
  line:= 0;    // Next line to write
  NexByte:= 0; // Next byte to write
  pass:= 0;    // Number of interlaced pictures
 
  SetLength(firtscodestack, 4096); // Stack for firts code
  SetLength(lastcodestack, 4096);  // Stack for previous code
  SetLength(codestack, 4096);      // Stack for links
  SetLength(linebuffer, width);
 
  p:= @b[0]; q:= @b[0];
  bitsleft:= 8;
 
  // Si el bitCount esta en rango 2 a 8
  if(bits >= 2) or (bits <= 8) then
  begin
    bits2    := (1 shl bits);
    nextcode  := bits2 + 2;
    codesize  := bits + 1;
    codesize2 := (1 shl codesize);
    oldcode  := NO_CODE;
    oldtoken  := NO_CODE;
    while TRUE do
    begin
      if bitsleft = 8 then
      begin
        inc(p);
        if p >= q then
        begin
          blocksize:= GifLZW^;
          inc(GifLZW);
          if blocksize < 1 then
          begin
            Result:= 0;
            Error:= TRUE;
            break;
          end else
          begin
            p:= @b[0];
            q:= p + blocksize;
            CopyMemory(@b[0], GifLZW, blocksize);
            inc(GifLZW, blocksize);
          end;
        end;
        bitsleft:= 0;
      end;
      thiscode:= p^;
      currentcode:= codesize + bitsleft;
      if currentcode <= 8 then
      begin
        p^ := (p^ shr codesize);
        bitsleft:= currentcode;
      end else
      begin
        inc(p);
        if p >= q then
        begin
          blocksize:= GifLZW^;
          inc(GifLZW);
          if blocksize < 1 then
          begin
            Error:= TRUE;
            Result:= 0;
            break;
          end else
          begin
            p:= @b[0];
            q:= p + blocksize;
            CopyMemory(@b[0], GifLZW, blocksize);
            inc(GifLZW, blocksize);
          end;
        end;
        thiscode:= thiscode or (p^ shl (8 - bitsleft));
        if currentcode <= 16 then
        begin
            bitsleft:= currentcode - 8;
            p^:= (p^ shr bitsleft);
        end else
        begin
          inc(p);
          if p >= q then
          begin
            blocksize:= GifLZW^;
            inc(GifLZW);
            if blocksize < 1 then
            begin
              Result:= 0;
              Error:= TRUE;
              break;
            end else
            begin
              p:= @b[0];
              q:= p + blocksize;
              CopyMemory(@b[0], GifLZW, blocksize);
              inc(GifLZW, blocksize);
            end;
          end;
          thiscode:= thiscode or (p^ shl (16 - bitsleft));
          bitsleft:= currentcode - 16;
          p^:= (P^ shr bitsleft);
        end;
      end;
 
      thiscode:= thiscode and wordmasktable[codesize];
      currentcode:= thiscode;
 
      if thiscode = (bits2+1) then  break; // encontrado EOI
      if thiscode > nextcode then
      begin
        Result:= 0;
        Error:= TRUE; // error("Codigo erroneo");
        break;
      end;
 
      if thiscode = bits2 then
      begin
        nextcode:= bits2 + 2;
        codesize:= bits + 1;
        codesize2:= 1 shl codesize;
        oldcode:= NO_CODE;
        oldtoken:= NO_CODE;
        continue;
      end;
 
      u:= PBYTE(firtscodestack);
 
      if thiscode = nextcode then
      begin
        if oldcode = NO_CODE then
        begin
          Result:= 0;
          Error:= TRUE; // error("Codigo erroneo");
          break;
        end;
        u^:= BYTE(oldtoken);
        inc(u);
        thiscode:= oldcode;
      end;
      while thiscode >= bits2 do
      begin
        u^:= lastcodestack[thiscode];
        inc(u);
        thiscode:= codestack[thiscode];
      end;
 
      oldtoken:= thiscode;
 
      // Escribir los datos ya descomprimidos en linebuffer en el bitmap
      while TRUE do
      begin
        linebuffer[NexByte]:= BYTE(thiscode);
        inc(NexByte);
        if NexByte >= width then
        begin
            // Escribir adaptando al formato del Bitmap
            if FBmpStream.GetBitCount > 4 then
              CopyMemory(FBmpStream.ScanLine(line), linebuffer, width)
            else
            // Es pf4bit
            begin
              LinePixels:= FBmpStream.ScanLine(line);
//              for X:= 0 to (width shr 1) - 1 do
              for X:= 0 to (width div 2) - 1 do
                LinePixels[X]:= (linebuffer[X*2] shl 4) or linebuffer[X*2+1];
            end;
            NexByte:= 0;
 
            // Chequea imagen entrelazada
            if (flags and $40) = $40 then
            begin
              inc(line, IncTable[pass]);
              if line >= height then
              begin
                inc(pass);
                line:= StarTable[pass];
              end;
            end else inc(line);
        end;
        if u <= PBYTE(firtscodestack) then break;
        dec(u);
        thiscode:= u^;
      end; // while TRUE 2º
 
      if (nextcode < 4096) and (oldcode <> NO_CODE) then
      begin
        codestack[nextcode]    := WORD(oldcode);
        lastcodestack[nextcode] := BYTE(oldtoken);
        inc(nextcode);
        if(nextcode >= codesize2) and (codesize < 12) then
        begin
          inc(codesize);
          codesize2:= 1 shl codesize;
        end;
      end;
      oldcode:= currentcode;
    end; // while TRUE 1º
  end; // Si el bitCount esta en rango 2 a 8
 
  if Error = FALSE then
  begin
    Result:= GifLZW - pGifLZW + 1;
    Ok:= TRUE;
  end else
  begin
    Ok:= FALSE;
    Result:= 0;
  end;
 
  // Volcamos a FBitmap
  FBitmap.LoadFromStream(FBMPStream);
 
end;  //AQUI FIN FUNCION

Por ser excesivamente largo sigo en el siguiente mensaje.

Saludos.
 

[escafandra]

Continua la clase TGif para Lazarus.

delphi

//------------------------------------------------------------------------------
// Empaqueta y escribe un archivo GIF
function TGIF.WriteGif(hFile: integer): LongInt;
var
  i: integer;
  Terminator: CHAR;
begin
  BuildWBuffers;
  // Cabecera del archivo GIF
  Result:= WriteGifHeader(hFile);
 
  // Cuerpo: Cabeceras locales e Imágenes comprimidas
  for i:= 0 to FListBitmap.Count-1 do
      Result:= Result + WriteImage(hFile, PGraphicBlock(FListBitmap.Items[i]));
 
  // Escribo los comentarios
  for i:= 0 to Comments.Count-1 do
    WriteComment(hFile, PCHAR(Comments.Strings));
 
  // Escribir el terminador GIF
  Terminator:= ';';
  Result:= Result + FileWrite(hFile, Terminator, sizeof(CHAR));
end;
 
//------------------------------------------------------------------------------
// Escribe la cabecera GIF del archivo, el Logical Screen Descriptor
// y la paleta global si procede
function TGIF.WriteGifHeader(hFile: integer): LongInt;
var
  gh: GIFHEADER;
  bits: WORD;
  background: WORD;
begin
  Result:= 0;
  FBMPStream.Position:= 0;
  FBitmap.SaveToStream(FBMPStream);
  bits  := FBMPStream.GetBitCount;
  if bits > 8 then exit;
 
  background:= WORD(FBitmap.Canvas.Pixels[0, 0]);
 
  //ZeroMemory(@gh, sizeof(GIFHEADER));
  FillChar(gh, sizeof(GIFHEADER), 0);
  CopyMemory(@gh.signature[0], PCHAR(GIFSIG), 6);
  gh.ScreenWidth  := WORD(FBitmap.Width);
  gh.ScreenHeight := WORD(FBitmap.Height);
  gh.background  := background;
 
  DefNColors := (1 shl bits);
  SetLength(DefPalette, DefNColors);
  FBMPStream.GetRGBTableColors(PBYTE(DefPalette));
 
  if(DefNColors = 0) then
        gh.flags := WORD(((bits-1) and $07) shl 4)
  else
        gh.flags := WORD($80 or ((bits-1) shl 4) or ((bits-1) and $07));
 
  Result := FileWrite(hFile, gh, sizeof(GIFHEADER));
  if(DefPalette <> nil) then
    inc(Result, FileWrite(hFile, DefPalette[0], 3*DefNColors));
end;
 
//------------------------------------------------------------------------------
// Escribe el IMAGEBLOCK de una imagen
// y su paleta local si la tiene, es decir, si es diferente de la Global
function TGIF.WriteIBlockHeader(hFile: integer; GBlock: PGraphicBlock): LongInt;
var
  ib: IMAGEBLOCK;
  bits: WORD;
  ncolors: integer;
  palette: array [0..255] of TRGBTable;
  LocalPalette: boolean;
begin
  FBMPStream.Position:= 0;
  GBlock.Bitmap.SaveToStream(FBMPStream);
  bits  := FBMPStream.GetBitCount;
 
  //ZeroMemory(@ib, sizeof(IMAGEBLOCK));
  FillChar(ib, sizeof(IMAGEBLOCK), 0);
  ib.Introducer:= BYTE(',');
  ib.left      := GBlock.Left;
  ib.top      := GBlock.Top;
  ib.width    := WORD(GBlock.Bitmap.Width);
  ib.height    := WORD(GBlock.Bitmap.Height);
  ncolors      := (1 shl bits);
 
 
  //Obtengo la Paleta de la Imagen
  FBMPStream.GetRGBTableColors(@palette[0]);
 
  // Si es igual a la global, no la considero.
  LocalPalette:= TRUE;
  if CmpPalette(@palette[0], ncolors) = TRUE then
    LocalPalette := FALSE;
 
  // Colocar el flag de paleta local y la longitud de la misma.
  if LocalPalette = FALSE then  ib.flags:= WORD(bits-1)
  else                          ib.flags:= WORD(((bits-1) and $07) or $80);
  if(Interlace)          then  ib.flags:= ib.flags or $40;
 
  // Escribo el IMAGEBLOCK de esta imagen
  Result:= FileWrite(hFile, ib, sizeof(IMAGEBLOCK));
 
  // Si tenemos paleta local, la escribimos
  if(LocalPalette = TRUE) then
    inc(Result, FileWrite(hFile, DefPalette[0], 3*DefNColors));
end;
 
//------------------------------------------------------------------------------
// Escribe un Fotograma
function TGIF.WriteImage(hFile: integer; GBlock: PGraphicBlock): LongInt;
var
  GCE:  GRAPHIC_CONTROL_EXTENSION;
begin
  // Escribir el Graphic Control Extension:
  GCE.Introducer := BYTE('!');
  GCE.Label_E    := $F9;
  GCE.BlockSize  := 4;
  GCE.flags      := (GBlock.Method shl 2) or (GBlock.UserInput shl 1) or GBlock.Transparency;
  GCE.DelayTime  := GBlock.DelayTime;
  GCE.TransparentColorIndex := GBlock.TransparentColorIndex;
  GCE.Terminator := 0;
  Result:= FileWrite(hFile, GCE, sizeof(GRAPHIC_CONTROL_EXTENSION));
 
  // Escribir el Image Block Header
  inc(Result, WriteIBlockHeader(hFile, GBlock));
 
  // escribir la imagen comprimida
  inc(Result, ZipImage(hFile, GBlock.Bitmap));
  if Loop = TRUE then
    inc(Result, WriteLoopNetscape(hFile));
end;
 
//------------------------------------------------------------------------------
// Escribe un Bloque en el archivo
function TGIF.Flush(hFile: integer; N: BYTE): LongInt;
begin
  Result:= FileWrite(hFile, N, sizeof(BYTE)) +
            FileWrite(hFile, CodeBuffer[0], N);
end;
 
//------------------------------------------------------------------------------
// Escribe los códigos comprimidos LZW y vuelca a disco cuando precisa
function TGIF.WriteCode(hFile: integer; Code: integer): LongInt;
var
  Temp: DWORD;
begin
  Result:= 0;
 
  ByteOffset:= BitOffset shr 3;
  BitsLeft  := BitOffset and 7;
 
  if(ByteOffset >= 254) then
  begin
    Result:= Flush(hFile, ByteOffset);
    CodeBuffer[0]:= CodeBuffer[ByteOffset];
    BitOffset    := BitsLeft;
    ByteOffset  := 0;
  end;
 
  if(BitsLeft > 0) then
  begin
    Temp:= (DWORD(code) shl BitsLeft) or CodeBuffer[ByteOffset];
    CodeBuffer[ByteOffset]  := BYTE(Temp);
    CodeBuffer[ByteOffset+1]:= BYTE(Temp shr 8);
    CodeBuffer[ByteOffset+2]:= BYTE(Temp shr 16);
  end else
  begin
    CodeBuffer[ByteOffset]  := BYTE(code);
    CodeBuffer[ByteOffset+1]:= BYTE(code shr 8);
  end;
 
  inc(BitOffset, CodeSize);
end;
 
//------------------------------------------------------------------------------
// Comprime una imagen en LZW
function TGIF.ZipImage(hFile: integer; Bitmap: TBitmap): LongInt;
var
  MinCodeSize: WORD;
  PrefixCode:WORD  ;
  SuffixChar:WORD ;
  hx,d: DWORD;
  X,Y: integer;      // Coordenadas de pixel
  XMax, YMax: integer;
  pass: integer;    // peses en imagenes entrelazadas
  LineBuffer: PByteArray;
begin
  FBMPStream.Position:= 0;
  Bitmap.SaveToStream(FBMPStream);
  MinCodeSize:= FBMPStream.GetBitCount;
  X:=0; Y:=0;
  pass:= 0;
 
  // Asegurarse de que el primer code size es legal
  // Las imagenes monocromas tienen 2 bits en LZW compresion
  if(MinCodeSize = 1) then  MinCodeSize := 2;
  if(MinCodeSize >= 2) and (MinCodeSize <= 8) then
  begin
      // escribir el primer code size
      Result:= FileWrite(hFile, MinCodeSize, sizeof(BYTE));
 
      // Inicializar el codificador
      BitOffset:= 0;
      InitTable(MinCodeSize);
      WriteCode(hFile, ClearCode);
      LineBuffer:= FBMPStream.ScanLine(0);
 
      if MinCodeSize >= 8 then
        SuffixChar:= (LineBuffer[0] and $FF)
      else
        SuffixChar:= ((LineBuffer[0] and $F0) shr 4);
 
      inc(X);
 
      if X = Bitmap.Width then
      begin
        X:= 0;
        inc(Y);
      end;
      if Y < Bitmap.Height then
      begin
        // Inicializar el prefijo
        PrefixCode:= SuffixChar;
 
        XMax:= Bitmap.Width;
        YMax:= Bitmap.Height;
        LineBuffer:= FBMPStream.ScanLine(Y);
        while (Y < YMax) and (pass < 4) do
        begin
            if MinCodeSize = 8 then
            begin
              SuffixChar:= LineBuffer[X];
              inc(X)
            end else
            begin
              if (X and 1) = 1 then SuffixChar:= (LineBuffer[X div 2] and $0F)  // Impar
              else                  SuffixChar:= ((LineBuffer[X div 2]and $F0) shr 4); // Par
              inc(X);
            end;
 
            // Derive an index into the code table
            hx:= (PrefixCode xor (SuffixChar shl 5)) mod TABLESIZE;
            d := 1;
 
            while(TRUE) do
            begin
              // Mirar si el code esta en la tabla
              if(CurrentCode[hx] = 0) then
              begin
                  // Si no, ponerlo
                  inc(Result, WriteCode(hFile, PrefixCode));
                  d:= FreeCode;
 
                  // Encontrar el siguiente FreeCode
                  if(FreeCode <= LARGESTCODE) then
                  begin
                    OldCode[hx]:= PrefixCode;
                    NewCode[hx]:= BYTE(SuffixChar);
                    CurrentCode[hx]:= FreeCode;
                    inc(FreeCode);
                  end;
 
                  // Expand the code size or scrap the table
                  if(d = MaxCode) then
                  begin
                    if(CodeSize < 12) then
                    begin
                        inc(CodeSize);
                        MaxCode:= MaxCode shl 1;
                    end else
                    begin
                        inc(Result, WriteCode(hFile, ClearCode));
                        InitTable(MinCodeSize);
                    end;
                  end;
                  PrefixCode:= SuffixChar;
                  break;
              end;
              if(OldCode[hx] = PrefixCode) and (NewCode[hx] = SuffixChar) then
              begin
                  PrefixCode:= CurrentCode[hx];
                  break;
              end;
              inc(hx, d);
              inc(d, 2);
              if(hx >= TABLESIZE) then dec(hx, TABLESIZE);
            end;  // While TRUE
 
            // Incrementando X e Y
            if(X >= XMax) then
            begin
              // Chequea imagen entrelazada
              if Interlace = TRUE then
              begin
                  inc(Y, IncTable[pass]);
                  if(Y >= YMax) then
                  begin
                    inc(pass);
                    Y:= StarTable[pass];
                  end;
              end else inc(Y);
              if Y = YMax then break;
              X:= 0;
              LineBuffer:= FBMPStream.ScanLine(Y);
            end;
        end;  // while (Y < YMax) and (pass < 4)
      end;
      // Escribe el PrefixCode
      inc(Result, WriteCode(hFile, PrefixCode));
 
      // Escribe el EofCode
      inc(Result, WriteCode(hFile, EofCode));
 
      // Flush the buffer
      if(BitOffset > 0) then inc(Result, Flush(hFile, (BitOffset+7) div 8));
 
      // Escribe un bloque de longitud 0
      inc(Result, Flush(hFile, 0));
  end
  else Result:= 0;
end;
 
//------------------------------------------------------------------------------
// Escribe un bucle NETSCAPE
function TGIF.WriteLoopNetscape(hFile: integer): LongInt;
begin
  // Loop de Netscape
  Result:= FileWrite(hFile, nl, sizeof(NETSCAPE_EXTENSION));
end;
 
//------------------------------------------------------------------------------
// Lee una extensión de comentario
function TGIF.GetCommentExtension(Offset: LongInt): LongInt;
var
  n: integer;
  AGifBuffer: PByteArray;
begin
  AGifBuffer:= PByteArray(GifBuffer);
  if(AGifBuffer[Offset] = BYTE('!')) and (AGifBuffer[Offset+1] = $FE) then
  begin
      n:= 1;
      inc(Offset, 2);
      while (n <> -1{EOF}) and (n > 0) do
      begin
        n:= AGifBuffer[Offset];
        inc(Offset, 1);
        Comments.Text:= Comments.Text + Copy(PCHAR(GifBuffer + Offset), 0, n);
        inc(Offset, n);
      end;
  end;
  Result:= Offset;
end;
 
//------------------------------------------------------------------------------
// Escribe una extensión de comentario
function TGIF.WriteComment(hFile: integer; Comment: PCHAR): LongInt;
var
  CEH: COMMENT_EXTENSION_HEADER;
  Len: integer;
  L, nbytes, Nulo: BYTE;
begin
  Nulo:= 0;
  Result:= 0;
  CEH.Introducer:= BYTE('!');
  CEH.Label_E:= $FE;
  Len:= Length(Comment);
  L:= 0;
  Result:= FileWrite(hFile, CEH, sizeof(CEH.Introducer) + sizeof(CEH.Label_E));
  while(L < Len) do
  begin
    nbytes:= min(Len, 255);
    inc(Result, FileWrite(hFile, nbytes, 1));
    nbytes:= min(Len-L, 255);
    inc(L, FileWrite(hFile, Comment^, nbytes));
    inc(Comment, L);
  end;
  inc(Result, L + FileWrite(hFile, Nulo, 1)); // Bloque nulo: Fin de Extensión
end;
 
//------------------------------------------------------------------------------
function TGIF.CmpPalette(Palette: pointer; nColors: integer): boolean;
begin
  Result:= FALSE;
  if(DefPalette <> nil) and (Palette <> nil) and (ncolors = DefNColors) then
      Result:= CompareMem(Palette, DefPalette, DefNColors*3);
end;
 
//------------------------------------------------------------------------------
procedure TGIF.InitTable(MinCodeSize: integer);
begin
  CodeSize := WORD(MinCodeSize+1);
  ClearCode:= WORD(1 shl MinCodeSize);
  EofCode  := WORD(ClearCode+1);
  FreeCode := WORD(ClearCode+2);
  MaxCode  := WORD(1 shl CodeSize);
 
  //ZeroMemory(CurrentCode, TABLESIZE * sizeof(WORD));
  FillChar(CurrentCode[0], TABLESIZE * sizeof(WORD), 0);
end;
 
//------------------------------------------------------------------------------
procedure  TGIF.BuildWBuffers();
begin
  SetLength(DefPalette, 256);
  SetLength(CodeBuffer, 259);
  SetLength(OldCode, TABLESIZE);
  SetLength(CurrentCode, TABLESIZE);
  SetLength(NewCode, TABLESIZE);
 
  //ZeroMemory(CurrentCode, TABLESIZE * sizeof(WORD));
  FillChar(CurrentCode[0], TABLESIZE * sizeof(WORD), 0);
end;
 
 
end.   

Cuando sea posible, subo todo el código en un adjunto.

Saludos.

[escafandra]

Lo siguiente es un visor de animaciones GIF para Lazarus:

delphi

unit Unit1;
 
{$mode objfpc}{$H+}
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  StdCtrls, gif;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Open: TButton;
    Save: TButton;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Timer1: TTimer;
    procedure OpenClick(Sender: TObject);
    procedure SaveClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { private declarations }
  public
    n: integer;
    Gif: TGIF;
    { public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered:= TRUE;
  Gif:= TGIF.Create;
  Timer1.Enabled:= false;
  Timer1.Interval:= 50;
end;
 
procedure TForm1.OpenClick(Sender: TObject);
begin
  if(OpenDialog1.Execute()) then
  begin
      gif.LoadFromFile(OpenDialog1.FileName);
      Timer1.Enabled:= gif.Loop;
      Image1.Picture.Bitmap.Assign(gif.GetBitmap);
  end;
end;
 
procedure TForm1.SaveClick(Sender: TObject);
begin
  if(Image1.Picture.Bitmap.Empty = FALSE) then
  begin
      if SaveDialog1.Execute then
      begin
        gif.SaveToFile(SaveDialog1.FileName);
        Image1.Picture.Bitmap.Assign(gif.GetBitmap);
      end;
  end;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
var
    i: integer;
begin
    i:= n mod Gif.GetBitmapCount;
    Timer1.Interval:= Gif.GetGraphicBlock(i)^.DelayTime*10;
    if Timer1.Interval = 0 then Timer1.Interval:= 40;
    Image1.Canvas.Draw(Gif.GetGraphicBlock(i)^.Left, Gif.GetGraphicBlock(i)^.Top, Gif.GetBitmap(i));
    inc(n);
end;
 
end.

Saludos.

[escafandra]

Parece que el problema de los archivos adjuntos está resuelto gracias a egostar. 

Lo prometido es deuda, así que subo un archivo adjunto con todo el código.


Saludos.

Archivos adjuntos

•  TGif Lazarus.rar   134,32KB   16 descargas

[escafandra]

Pasados unos cuantos años he vuelto sobre este tema tras darme cuenta de la falta de compatibilidad de las clase con algunos GIF y sobre todo debido al soporte muy parcial que hace Windows con GDIplus. En efecto, GDI plus no es compatible con todos los "Disposal Method" (formas de eliminación de cada frame animado) definidos en la especificación Gif89a y tampoco permite escribir archivos gif de más de una imagen. Llevado por esta situación y viendo que la clase TGIF que escribí es mucho más versátil y potente, la he actualizado. En realidad los cambios son mínimos.

 

Uno de los temas más complejos es el tratamiento preciso del Disposal Method tipo 3 que no todas las implementaciones lo hacen bien. En principio yo dejé este tema para la implementación del visor, pero he pensado que sería mejor idea dar soporte desde una función ya implementada que, aunque no me parecía que debiese pertenecer a la clase TGIF, ya que ésta está enfocada para los archivos y no para el visor (quizás la debería haber llamado TGifFile), si me pareció interesante aportarla para facilitar toda la funcionalidad a la construcción de un visor o de una creador de gif animados.

 

Otro problema son las transparencias. Por lo general, en un mundo en el que el problema de espacio de memoria no es el que había hace décadas, los formatos de color indexado se contemplan poco y las transparencias vienen dadas por color y no por índice de color. Esto supone que algunos gif pueden tener varios colores iguales en la paleta pero sólo uno de ellos será transparente con lo que tenemos una ambigüedad. Si tanto la API como las implementaciones de ayudas gráficas de los lenguajes se basan en un color y no en un índice, el problema no está resuelto. En la clase TGIF lo resuelvo escaneando los colores de la paleta y cambiando ligeramente los repetidos.

 

Comentar que la versión Lazarus difiere de la de delphi porque no soporta TBitmaps de color indexado, esto me obligó a escribir una clase de apoyo para conseguirlo, basada en Stream, que permite el uso de paletas y colores indexados.

 

Para el que no sepa las interioridades del formato gif, he de aclarar que nació en una época en la que el ahorro de memoria era básico en las máquinas y en el streaming por la red. Esto supuso el uso de bitmaps de color indexado y paletas, mucho más pequeños que los bitmaps de color verdadero de 24 ó 32 bits, en la que cada color se guarda con cada pixel. También supuso la creación de un algoritmo de compresión. Estas animaciones se usaron en los navegadores web. Netscape tuvo mucho que ver con propuestas al formato, como el famoso looping que dio lugar a las animaciones sin fin que hoy conocemos como algo habitual

 

Aunque no es lo común en el código que suelo publicar, al implementar esta clase he huido del uso del API de Windows, para facilitar una posible futura portabilidad y para no alejarme de la implementación para Lazarus.

 

Las mejoras se pueden resumir así:

1. Mejor implementación de los Disposal Methods en una función de soporte PaintGB.

2. Mejoras en las transparencias debido al problema de dar un índice de color y no el color mismo.

3. Se añade una función que no pertenece a la clase, para dar soporte a la visualización.

 

La función de apoyo para visualización es la siguiente:

(versiones de delphi lazarus y cpp),

delphi

// Delphi 7 y Berlin
//---------------------------------------------------------------------------
// Dibuja un GraphicBlock de un Gif localizado por su índice respetando el
// DisponsalMethod del fotograma que se va a quitar
procedure PaintGB(Canvas: TCanvas; var Gif: TGIF; Index: integer; BkColor: TColor; _Forward: boolean);
var
  Frames: integer;
  OldDisponsalMethod: BYTE;
  OldIndex: integer;
begin
  Frames:= Gif.GetBitmapCount();
 
  if _Forward then
    OldIndex:= (Frames + Index -1) mod Frames
  else
    OldIndex:= (Index + 1) mod Frames;
 
  OldDisponsalMethod:= Gif.GetGraphicBlock(OldIndex).Method;
 
  // Method = 0 (Sin accion específica) y Method = 1 (No se quita la imagen)
  if OldDisponsalMethod < 2 then
  begin
    // No se borra la imagen se deja como está...
  end;
 
  // Method = 2 (Se restaura al color de fondo)
  if OldDisponsalMethod = 2 then
  begin
    Canvas.Brush.Color:= BkColor;
    Canvas.FillRect(Canvas.ClipRect);
  end;
 
  // Method = 3 (Se restaura al estado previo el area sobreescrita)
  if OldDisponsalMethod = 3 then
  begin
    Canvas.Draw(Gif.GetGraphicBlock(OldIndex).Left, Gif.GetGraphicBlock(OldIndex).Top, Gif.OldImage);
  end;
 
  // Guardando la imagen previa para el caso de DisponsalMethod = 3
  if Gif.GetGraphicBlock(Index).Method = 3 then
  begin
    Gif.OldImage.Width:=  Gif.GetBitmap(Index).Width;
    Gif.OldImage.Height:= Gif.GetBitmap(Index).Height;
    Gif.OldImage.Canvas.CopyMode:= cmSrcCopy;
    Gif.OldImage.Canvas.CopyRect(Gif.GetFrameRect(Index), Canvas, Gif.GetBitmapRect(Index));
  end;
 
  // Dibujando la imegen actual
  Canvas.Draw(Gif.GetGraphicBlock(Index).Left, Gif.GetGraphicBlock(Index).Top, Gif.GetBitmap(Index));
end;

delphi

// Lazarus
//---------------------------------------------------------------------------
// Dibuja un GraphicBlock de un Gif localizado por su índice respetando el
// DisponsalMethod del fotograma que se va a quitar
procedure PaintGB(Canvas: TCanvas; var Gif: TGIF; Index: integer; BkColor: TColor; _Forward: boolean);
var
  Frames: integer;
  OldDisponsalMethod: BYTE;
  OldIndex: integer;
begin
  Frames:= Gif.GetBitmapCount();
 
  if _Forward then
    OldIndex:= (Frames + Index -1) mod Frames
  else
    OldIndex:= (Index + 1) mod Frames;
 
  OldDisponsalMethod:= Gif.GetGraphicBlock(OldIndex).Method;
 
  // Method = 0 (Sin accion específica) y Method = 1 (No se quita la imagen)
  if OldDisponsalMethod < 2 then
  begin
    // No se borra la imagen se deja como está...
   end;
 
  // Method = 2 (Se restaura al color de fondo)
  if OldDisponsalMethod = 2 then
  begin
    Canvas.Brush.Color:= BkColor;
    Canvas.FillRect(Canvas.ClipRect);
  end;
 
  // Method = 3 (Se restaura al estado previo el area sobreescrita)
  if (OldDisponsalMethod = 3) then
  begin
    Canvas.Draw(Gif.GetGraphicBlock(OldIndex).Left, Gif.GetGraphicBlock(OldIndex).Top, Gif.OldImage);
  end;
 
  // Guardando la imagen previa para el caso de DisponsalMethod = 3
  if Gif.GetGraphicBlock(Index).Method = 3 then
  begin
    Gif.OldImage.Width:=   Gif.GetBitmap(Index).Width;
    Gif.OldImage.Height:= Gif.GetBitmap(Index).Height;
    Gif.OldImage.Canvas.CopyMode:= cmSrcCopy;
    Gif.OldImage.Canvas.CopyRect(Gif.GetFrameRect(Index), Canvas, Gif.GetBitmapRect(Index));
  end;
 
  // Dibujando la imegen actual
  Canvas.Draw(Gif.GetGraphicBlock(Index).Left, Gif.GetGraphicBlock(Index).Top, Gif.GetBitmap(Index));
end;

cpp

// Cpp Builder 5 y Berlin
//---------------------------------------------------------------------------
// Dibuja un GraphicBlock de un Gif localizado por su índice respetando el
// DisponsalMethod del fotograma que se va a quitar
void PaintGB(TCanvas *Canvas, TGIF* Gif, int Index, TColor BkColor, bool Forward)
{
  int Frames = Gif->GetBitmapCount();
  int OldIndex;
  if(Forward)
    OldIndex = (Frames + Index -1) % Frames;
  else
    OldIndex = (Index + 1) % Frames;
 
  BYTE OldDisponsalMethod = Gif->GetGraphicBlock(OldIndex)->Method;
 
  // Method = 0 (Sin accion específica) y Method = 1 (No se quita la imagen)
  if(OldDisponsalMethod < 2){
    // No se borra la imagen se deja como está...
  }
 
  // Method = 2 (Se restaura al color de fondo)
  if(OldDisponsalMethod == 2){
    Canvas->Brush->Color = BkColor;
    Canvas->FillRect(TRect(0,0,Gif->ScreenWidth, Gif->ScreenHeight));//.Canvas->ClipRect);
  }
 
  // Method = 3 (Se restaura al estado previo el area sobreescrita)
  if(OldDisponsalMethod == 3){// && Index > 0){
    Canvas->Draw(Gif->GetGraphicBlock(OldIndex)->Left, Gif->GetGraphicBlock(OldIndex)->Top, Gif->OldImage);
  }
 
  // Guardando la imagen previa para el caso de DisponsalMethod = 3
  if(Gif->GetGraphicBlock(Index)->Method == 3){
    Gif->OldImage->Width  = Gif->GetBitmap(Index)->Width;
    Gif->OldImage->Height = Gif->GetBitmap(Index)->Height;
    Gif->OldImage->Canvas->CopyMode = cmSrcCopy;
    TRect DestRect = Gif->GetFrameRect(Index);
    TRect SourceRect = Gif->GetBitmapRect(Index);
    Gif->OldImage->Canvas->CopyRect(DestRect, Canvas, SourceRect);
  }
 
  // Dibujando la imegen actual
  Canvas->Draw(Gif->GetGraphicBlock(Index)->Left, Gif->GetGraphicBlock(Index)->Top, Gif->GetBitmap(Index));
}

Hay que tener muy presente un detalle a la hora de visualizar un Gif que use Disposal Method tipo 3, como al desaparecer un frame debe restaurarlo con lo que había en su lugar antes de ser representado, si por un error en la implementación, representáramos dos veces ese frame (dos llamadas consecutivas a la función) ya no tendríamos  la imagen previa guardada correctamente, es por eso que la función permite pintar hacia delante y hacia atrás, pero jamás se debe pintar dos veces el mismo frame del tipo 3 si queremos que la visualización sea fiel a lo que diseñó la persona que creó el gif.

 

Sobre la base de esta revisión voy a publicar le revisión del componente TGifViewer, para delphi, compatible con Berlin. Otra versión para Builder, también compatible con Berlin. Y añadiré otra versión para Lazarus. También publicaré una pequeña aplicación para visualizar gif, editarlos o crear alguna pequeña animación, GIF Creator.

 

 

 

Saludos.

Archivos adjuntos

•  gif delphi.zip   11,53KB   8 descargas
•  lz_gif Lazarus.zip   12,42KB   11 descargas
•  gif Builder.zip   11,85KB   6 descargas

[enecumene]

Bestial