|
|
@@ -0,0 +1,2785 @@
|
|
|
+Unit uGifViewer;
|
|
|
+
|
|
|
+(*==============================================================================
|
|
|
+ DESCRIPTION : Visual component for displaying an animated image in the
|
|
|
+ GIF (Graphic Interchange Format) format
|
|
|
+ DATE : 17/06/2018
|
|
|
+ UPDATE : 01/07/2025
|
|
|
+ VERSION : 1.0
|
|
|
+ AUTHOR : J.Delauney (BeanzMaster)
|
|
|
+ CONTRIBUTORS : Jipete, Jurassik Pork, bpranoto, Alexander Koblov
|
|
|
+ LICENSE : MPL 2.0
|
|
|
+================================================================================
|
|
|
+*)
|
|
|
+
|
|
|
+{$mode objfpc}{$H+}
|
|
|
+
|
|
|
+Interface
|
|
|
+
|
|
|
+Uses
|
|
|
+ Types, Classes, SysUtils, Graphics, Math, Contnrs, Dialogs,
|
|
|
+ Controls, ExtCtrls,
|
|
|
+ Lresources, GifViewerStrConsts,
|
|
|
+ uFastBitmap;
|
|
|
+
|
|
|
+{%region=====[ Définitions des types et constantes utiles pour le format GIF ]===================================}
|
|
|
+Const
|
|
|
+ GIF_MaxColors : Integer = 256; // Nombre de couleurs maximum supportées. NE PAS TOUCHER A CETTE VALEUR
|
|
|
+ GIF_DelayFactor : Integer = 10; // Facteur de multiplication pour les délais en ms entre chaque image de l'animation
|
|
|
+ GIF_DefaultDelay : Integer = 100; // 10*10
|
|
|
+
|
|
|
+Type
|
|
|
+ TGIFVersion = (gvUnknown, gv87a, gv89a);
|
|
|
+ TGIFVersionRec = Array[0..2] Of AnsiChar;
|
|
|
+
|
|
|
+Const
|
|
|
+ GIFVersions : Array[gv87a..gv89a] Of TGIFVersionRec = ('87a', '89a');
|
|
|
+
|
|
|
+Type
|
|
|
+ { En-tête }
|
|
|
+ TGIFFileHeader = Packed Record
|
|
|
+ Signature: Array[0..2] Of AnsiChar; // 'GIF'
|
|
|
+ Version: TGIFVersionRec; // '87a' ou '89a' }
|
|
|
+ End;
|
|
|
+
|
|
|
+ { Description globale de l'image }
|
|
|
+ TGIFLogicalScreenDescriptorRec = Packed Record
|
|
|
+ ScreenWidth: Word; // Largeur de l'image en pixels // Width
|
|
|
+ ScreenHeight: Word; // Hauteur de l'image en pixels // Height
|
|
|
+ PackedFields: Byte; // champs compactés // Compacted field
|
|
|
+ BackgroundColorIndex: Byte; // Index globale de la couleur de fond // Index of background color
|
|
|
+ AspectRatio: Byte; // Ratio d'échelle = (AspectRatio + 15) / 64
|
|
|
+ End;
|
|
|
+
|
|
|
+ { Description d'une image }
|
|
|
+ TGIFImageDescriptorRec = Packed Record
|
|
|
+ //Separator: byte; // On lis toujours un byte avant // we always read it before
|
|
|
+ Left: Word; // Colonne en pixels par rapport au bord gauche de l'écran // Column in pixels from the left edge of the screen
|
|
|
+ Top: Word; // Rangée en pixels par rapport au haut de l'écran // Row in pixels from the top edge of the screen
|
|
|
+ Width: Word; // Largeur de l'image en cours en pixels // image width
|
|
|
+ Height: Word; // Hauteur de l'image en cours pixels // Image height
|
|
|
+ PackedFields: Byte; // Champs compactés // Compacted field
|
|
|
+ End;
|
|
|
+
|
|
|
+ { Graphic Control Extension bloc a.k.a GCE }
|
|
|
+ TGIFGraphicControlExtensionRec = Packed Record
|
|
|
+ // BlockSize: byte; // Normalement toujours 4 octets // Always 4 bytes
|
|
|
+ PackedFields: Byte; // Champs compacté // Compacted field
|
|
|
+ DelayTime: Word; // Délai entre chaque image en centième de secondes // Delay between each image in hundredths of a second
|
|
|
+ TransparentColorIndex: Byte; // Index dans la palette si plus petit ou égale // Delay between each image in hundredths of a second
|
|
|
+ // Terminator: Byte; // Normalement toujours ZERO // Normally always ZERO
|
|
|
+ End;
|
|
|
+
|
|
|
+ TGIFDisposalFlag = (dmNone, dmKeep, dmErase, dmRestore); // Methodes pour l'affichage des images lors de l'animation
|
|
|
+
|
|
|
+ { Plain Text Extension }
|
|
|
+ TGIFPlainTextExtensionRec = Packed Record
|
|
|
+ // BlockSize: byte; // Normalement égal à 12 octets // Normally equal to 12 bytes
|
|
|
+ Left, Top, Width, Height: Word; // Positions et dimensions du texte // position and dimension of text
|
|
|
+ CellWidth, CellHeight: Byte; // Dimensions d'une cellule dans l'image // Size of cell
|
|
|
+ TextFGColorIndex, // Index de la couleur de fond dans la palette // Index of the background color
|
|
|
+ TextBGColorIndex: Byte; // Index de la couleur du texte dans la palette // Index of the text color
|
|
|
+ End;
|
|
|
+
|
|
|
+ { Application Extension }
|
|
|
+ TGIFApplicationExtensionRec = Packed Record
|
|
|
+ AppID: Array [0..7] Of AnsiChar; // Identification de l'application majoritairement 'NETSCAPE' ou ''
|
|
|
+ AppAuthenticationCode: Array [0..2] Of AnsiChar; // Code d'authentification ou numero de version
|
|
|
+ End;
|
|
|
+
|
|
|
+ { Informations de "l'application extension" si disponible }
|
|
|
+ TGIFNSLoopExtensionRec = Packed Record
|
|
|
+ Loops: Word; // Nombre de boucle de l'animation 0 = infinie // nb loop
|
|
|
+ BufferSize: DWord; // Taille du tampon. Usage ?????
|
|
|
+ End;
|
|
|
+
|
|
|
+Const
|
|
|
+ // Description des masques pour la description globale de l'image
|
|
|
+ GIF_GLOBALCOLORTABLE = $80; // Défini si la table de couleurs globale suit la description globale
|
|
|
+ GIF_COLORRESOLUTION = $70; // Résolution de la couleur (BitsPerPixel) - 3 bits
|
|
|
+ GIF_GLOBALCOLORTABLESORTED = $08; // Définit si la palette globale est triée - 1 bit
|
|
|
+ GIF_COLORTABLESIZE = $07; // Taille de la palette - 3 bits
|
|
|
+ GIF_RESERVED = $0C; // Réservé - doit être défini avec $00 - Taille des données = 2^value+1 - 3 bits
|
|
|
+
|
|
|
+ // Descption des masques pour les images
|
|
|
+ GIF_LOCALCOLORTABLE = $80; // Défini si la table de couleurs locale suit la description de l'image
|
|
|
+ GIF_INTERLACED = $40; // Défini si l'image est entrelacée
|
|
|
+ GIF_LOCALCOLORTABLESORTED = $20; // Définit si la palette locale est triée
|
|
|
+
|
|
|
+ // Identification des blocs
|
|
|
+ GIF_PLAINTEXT = $01;
|
|
|
+ GIF_GRAPHICCONTROLEXTENSION = $F9;
|
|
|
+ GIF_COMMENTEXTENSION = $FE;
|
|
|
+ GIF_APPLICATIONEXTENSION = $FF;
|
|
|
+ GIF_IMAGEDESCRIPTOR = $2C; // ','
|
|
|
+ GIF_EXTENSIONINTRODUCER = $21; // '!'
|
|
|
+ GIF_TRAILER = $3B; // ';'
|
|
|
+
|
|
|
+ // Graphic Control Extension - Définition des masques pour les paramètres
|
|
|
+ GIF_NO_DISPOSAL = $00; // 0
|
|
|
+ GIF_DO_NOT_DISPOSE = $04; // 1
|
|
|
+ GIF_RESTORE_BACKGROUND_COLOR = $08; // 2
|
|
|
+ GIF_RESTORE_PREVIOUS = $12; // 3
|
|
|
+ GIF_DISPOSAL_ALL = $1C; // bits 2-4 ($1C)
|
|
|
+ GIF_USER_INPUT_FLAG = $02;
|
|
|
+ GIF_TRANSPARENT_FLAG = $01;
|
|
|
+ GIF_RESERVED_FLAG = $E0;
|
|
|
+
|
|
|
+ // Identification des sous-blocs pour "Application Extension"
|
|
|
+ GIF_LOOPEXTENSION = 1;
|
|
|
+ GIF_BUFFEREXTENSION = 2;
|
|
|
+
|
|
|
+Const
|
|
|
+ GifGCEDisposalModeStr : Array[TGIFDisposalFlag] Of String = ('None', 'Keep', 'Erase', 'Restore');
|
|
|
+
|
|
|
+Type
|
|
|
+ { Informations sur une image de l'animation }
|
|
|
+ TGIFFrameInformations = Record
|
|
|
+ Left, Top, // Position de l'image
|
|
|
+ Width, Height: Integer; // Dimension de l'image
|
|
|
+ HasLocalPalette: Boolean; // Palette locale disponible
|
|
|
+ IsTransparent: Boolean; // Image transparente
|
|
|
+ UserInput: Boolean; // Données personnelle
|
|
|
+ BackgroundColorIndex: Byte; // Normalement seulement valide si une palette globale existe
|
|
|
+ TransparentColorIndex: Byte; // Index de la couleur transparente
|
|
|
+ DelayTime: Word; // Délai d'animation
|
|
|
+ Disposal: TGIFDisposalFlag; // Methode d'affichage
|
|
|
+ Interlaced: Boolean; // Image entrelacée
|
|
|
+ End;
|
|
|
+ PGifFrameInformations = ^TGifFrameInformations;
|
|
|
+
|
|
|
+ {%endregion%}
|
|
|
+
|
|
|
+ { TGIFFastMemoryStream }
|
|
|
+ { Classe d'aide à la lecture des données dans un flux en mémoire }
|
|
|
+ TGIFFastMemoryStream = Class
|
|
|
+ Private
|
|
|
+ FBuffer: PByte;
|
|
|
+ FPosition: Int64;
|
|
|
+ FBytesRead, FBytesLeft, FSize: Int64;
|
|
|
+ Public
|
|
|
+ Constructor Create(AStream : TStream);
|
|
|
+ Destructor Destroy; Override;
|
|
|
+
|
|
|
+ { Lit un Byte dans le tampon / Read a byte in buffer }
|
|
|
+ Function ReadByte: Byte;
|
|
|
+ { Lit un Word dans le tampon / Read a word in buffer}
|
|
|
+ Function ReadWord: Word;
|
|
|
+ { Lit un DWord dans le tampon / Read a DWord in buffer }
|
|
|
+ Function ReadDWord: DWord;
|
|
|
+ { Lit et retourne un tampon "Buffer" de taille "Count" octets / Read a buffer of size "count" }
|
|
|
+ Function Read(Var Buffer; Count : Int64): Int64;
|
|
|
+ { Déplacement dans le flux de "Offset" depuis "Origin"
|
|
|
+ TSeekOrigin =
|
|
|
+ - soBeginning : Depuis le début du flux
|
|
|
+ - soCurrent : a partir de la position courante
|
|
|
+ - soEnd : A partir de la fin du flux
|
|
|
+ }
|
|
|
+ Function Seek(Const Offset : Int64; Origin : TSeekOrigin): Int64;
|
|
|
+ { Déplacement dans le flux vers l'avant de "Cnt" octet depuis la position courrante }
|
|
|
+ Procedure SeekForward(Cnt : Integer);
|
|
|
+ { Indique si la fin du flux est atteinte (EOS = End Of Stream) }
|
|
|
+ Function EOS: Boolean;
|
|
|
+
|
|
|
+ { Retourne la taille du flux en octet // Size in byte of the buffer}
|
|
|
+ Property Size: Int64 read FSize;
|
|
|
+ { Retourne la position courrante de lecture dans le tampon // Current position in buffer }
|
|
|
+ Property Position: Int64 read FPosition;
|
|
|
+ End;
|
|
|
+
|
|
|
+ { TGIFLoadErrorEvent : Fonction d'évènement levée en cas d'erreur(s) dans le chargement // Event raise on error }
|
|
|
+ TGIFLoadErrorEvent = Procedure(Sender : TObject; Const ErrorCount : Integer; Const ErrorList : TStringList) Of Object;
|
|
|
+
|
|
|
+ { TGIFImageListItem }
|
|
|
+ { Définition d'une image contenue dans le fichier GIF }
|
|
|
+ TGIFImageListItem = Class
|
|
|
+ Private
|
|
|
+ FBitmap: TFastBitmap;
|
|
|
+ FDrawMode: TGIFDisposalFlag;
|
|
|
+ FLeft, FTop: Integer;
|
|
|
+ FComment: TStringList;
|
|
|
+ FDelay: Integer;
|
|
|
+ FTransparent: Boolean;
|
|
|
+ FIsCorrupted : Boolean;
|
|
|
+ Protected
|
|
|
+ Public
|
|
|
+ Constructor Create;
|
|
|
+ Destructor Destroy; Override;
|
|
|
+
|
|
|
+ { Objet contenant l'image }
|
|
|
+ Property Bitmap: TFastBitmap read FBitmap write FBitmap;
|
|
|
+ { Mode de rendu de l'image // Render Mode}
|
|
|
+ Property DrawMode: TGIFDisposalFlag read FDrawMode write FDrawMode;
|
|
|
+ { Position gauche de l'image }
|
|
|
+ Property Left: Integer read FLeft write FLeft;
|
|
|
+ { Position Haut de l'image }
|
|
|
+ Property Top: Integer read FTop write FTop;
|
|
|
+ { Temps d'attente entre deux image de l'animation }
|
|
|
+ Property Delay: Integer read FDelay write FDelay;
|
|
|
+ { Commentaire sur l'image }
|
|
|
+ Property Comment: TStringList read FComment write FComment;
|
|
|
+ { Retourne TRUE si l'image utilise la transparence }
|
|
|
+ Property IsTransparent: Boolean read FTransparent write FTransparent;
|
|
|
+ { Indique si l'image est corrompue }
|
|
|
+ property IsCorrupted : Boolean read FIsCorrupted write FIsCorrupted;
|
|
|
+ End;
|
|
|
+
|
|
|
+ { TGIFImageList }
|
|
|
+ { Classe d'aide à la gestion des images contenues dans le fichier GIF }
|
|
|
+ { Helper class for manage image in GIF }
|
|
|
+ TGIFImageList = Class(TObjectList)
|
|
|
+ Private
|
|
|
+ Protected
|
|
|
+ Function GetItems(Index : Integer): TGIFImageListItem;
|
|
|
+ Procedure SetItems(Index : Integer; AGifImage : TGIFImageListItem);
|
|
|
+ Public
|
|
|
+ { Efface la liste }
|
|
|
+ Procedure Clear; Override;
|
|
|
+ { Ajoute une nouvelle image vide à la liste }
|
|
|
+ Function AddNewImage: TGIFImageListItem;
|
|
|
+ { Ajout d'une image dans la liste }
|
|
|
+ Function Add(AGifImage : TGIFImageListItem): Integer;
|
|
|
+ { Extraction d'une image de la liste }
|
|
|
+ Function Extract(Item : TGIFImageListItem): TGIFImageListItem;
|
|
|
+ { Effacement d'une image dans la liste }
|
|
|
+ Function Remove(AGifImage : TGIFImageListItem): Integer;
|
|
|
+ { Retourne l'index de l'image recherchée (retourne -1 si non trouvé) }
|
|
|
+ Function IndexOf(AGifImage : TGIFImageListItem): Integer;
|
|
|
+ { Retourne la première image }
|
|
|
+ Function First: TGIFImageListItem;
|
|
|
+ { Retourne la dernière image }
|
|
|
+ Function Last: TGIFImageListItem;
|
|
|
+ { Insertion d'une image à la position "Index" }
|
|
|
+ Procedure Insert(Index : Integer; AGifImage : TGIFImageListItem);
|
|
|
+
|
|
|
+ { Liste des images }
|
|
|
+ Property Items[Index: Integer]: TGIFImageListItem read GetItems write SetItems; Default;
|
|
|
+ End;
|
|
|
+
|
|
|
+ { TGIFImageLoader }
|
|
|
+ { Classe spécialisée pour la lecture d'une image au format GIF }
|
|
|
+ { Special class for read a GIF }
|
|
|
+ TGIFImageLoader = Class
|
|
|
+ Private
|
|
|
+ FCurrentLayerIndex: Integer;
|
|
|
+ FGIFFIleHeader: TGIFFileHeader;
|
|
|
+ FLogicalScreenChunk: TGIFLogicalScreenDescriptorRec;
|
|
|
+ FHasGlobalPalette: Boolean;
|
|
|
+ FTransparent: Boolean;
|
|
|
+ FGlobalPalette: TColor32List;
|
|
|
+ FVersion: String;
|
|
|
+
|
|
|
+ FWidth, FHeight: Integer;
|
|
|
+ FBackgroundColor: TColor32;
|
|
|
+
|
|
|
+ FFrames: TGIFImageList;
|
|
|
+
|
|
|
+ FErrorList: TStringList;
|
|
|
+ FErrorCount: Integer;
|
|
|
+ FOnLoadError: TGIFLoadErrorEvent;
|
|
|
+ Procedure SetCurrentLayerIndex(AValue : Integer);
|
|
|
+
|
|
|
+ Protected
|
|
|
+ Memory: TGIFFastMemoryStream;
|
|
|
+
|
|
|
+ CurrentFrameInfos: TGifFrameInformations;
|
|
|
+
|
|
|
+ Function GetFrameCount: Integer;
|
|
|
+ Procedure LoadFromMemory();
|
|
|
+ Function CheckFormat(): Boolean;
|
|
|
+ Function ReadImageProperties: Boolean;
|
|
|
+ Procedure AddError(Msg : String);
|
|
|
+ Procedure NotifyError;
|
|
|
+ Public
|
|
|
+ Constructor Create;
|
|
|
+ Destructor Destroy; Override;
|
|
|
+
|
|
|
+ { LoadFromStream : Charge les données depuis un flux }
|
|
|
+ Procedure LoadFromStream(aStream : TStream); Virtual;
|
|
|
+ { LoadFromFile : Charge les données depuis un fichier physique }
|
|
|
+ Procedure LoadFromFile(Const FileName : String); Virtual;
|
|
|
+ { Chargement depuis une Resource Lazarus }
|
|
|
+ Procedure LoadFromResource(Const ResName : String);
|
|
|
+ { Retourne la version du fichier GIF }
|
|
|
+ Property Version: String read FVersion;
|
|
|
+ { Retourne la largeur de l'image GIF }
|
|
|
+ Property Width: Integer read FWidth;
|
|
|
+ { Retourne la hauteur de l'image GIF }
|
|
|
+ Property Height: Integer read FHeight;
|
|
|
+ { Retourne la couleur de l'image GIF si elle existe,. Sinon retourne une couleur transparente (clrTransparent) }
|
|
|
+ Property BackgroundColor: TColor32 read FBackgroundColor write FBackgroundColor;
|
|
|
+ { Prise en charge de la transparence dans l'image GIF // Take transparency in account}
|
|
|
+ Property Transparent: Boolean read FTransparent write FTransparent;
|
|
|
+ { Retourne l'index courrant de l'image de l'animation traité // Return the current index frame}
|
|
|
+ Property CurrentFrameIndex: Integer read FCurrentLayerIndex write SetCurrentLayerIndex;
|
|
|
+ { Liste des images de l'animation // List of frame}
|
|
|
+ Property Frames: TGIFImageList read FFrames;
|
|
|
+ { Nombre d'image de l'animation // Nb frames }
|
|
|
+ Property FrameCount: Integer read GetFrameCount;
|
|
|
+ { Nombre d'erreur produite loars d'un cahrgement ou d'un enregistrement // Nb error }
|
|
|
+ Property ErrorCount: Integer read FErrorCount;
|
|
|
+ { Liste des erreurs // List of error }
|
|
|
+ Property Errors: TStringList read FErrorList;
|
|
|
+
|
|
|
+ { Evenement pour intercepter les erreurs notifiées lors du chargement des données // Error Event }
|
|
|
+ Property OnLoadError: TGIFLoadErrorEvent read FOnLoadError write FOnLoadError;
|
|
|
+ End;
|
|
|
+
|
|
|
+ { TGIFRenderCacheListItem }
|
|
|
+ { Définition d'une image cache de l'animation }
|
|
|
+ { Image cache class }
|
|
|
+ TGIFRenderCacheListItem = Class
|
|
|
+ Private
|
|
|
+ FBitmap: Graphics.TBitmap;
|
|
|
+ FDelay: Integer;
|
|
|
+ FIsCorrupted : Boolean;
|
|
|
+ Public
|
|
|
+ Constructor Create;
|
|
|
+ Destructor Destroy; Override;
|
|
|
+ { Image cache prérendu de l'animation }
|
|
|
+ Property Bitmap: Graphics.TBitmap read FBitmap write FBitmap;
|
|
|
+ { Temps d'attente en ms avec l'image suivante }
|
|
|
+ Property Delay: Integer read FDelay write FDelay;
|
|
|
+ { Indique si l'image est corrompue }
|
|
|
+ property IsCorrupted : Boolean read FIsCorrupted write FIsCorrupted;
|
|
|
+ End;
|
|
|
+
|
|
|
+ { TGIFRenderCacheList }
|
|
|
+ { Classe d'aide à la gestion des images rendues de l'animation }
|
|
|
+ { Helper class for manage list of image cache }
|
|
|
+ TGIFRenderCacheList = Class(TObjectList)
|
|
|
+ Private
|
|
|
+ Protected
|
|
|
+ Function GetItems(Index : Integer): TGIFRenderCacheListItem;
|
|
|
+ Procedure SetItems(Index : Integer; AGIFRenderCache : TGIFRenderCacheListItem);
|
|
|
+ Public
|
|
|
+ { Efface la liste }
|
|
|
+ Procedure Clear; Override;
|
|
|
+ { Ajoute un nouvel objet cache vide }
|
|
|
+ Function AddNewCache: TGIFRenderCacheListItem;
|
|
|
+ { Ajoute un nouveau cache }
|
|
|
+ Function Add(AGIFRenderCache : TGIFRenderCacheListItem): Integer;
|
|
|
+ { Extrait un cache de la liste }
|
|
|
+ Function Extract(Item : TGIFRenderCacheListItem): TGIFRenderCacheListItem;
|
|
|
+ { Supprime un cache de la liste }
|
|
|
+ Function Remove(AGIFRenderCache : TGIFRenderCacheListItem): Integer;
|
|
|
+ { Retourne l'index du cache recherchée (retourne -1 si non trouvé) }
|
|
|
+ Function IndexOf(AGIFRenderCache : TGIFRenderCacheListItem): Integer;
|
|
|
+ { Retourne le premier élément de la liste }
|
|
|
+ Function First: TGIFRenderCacheListItem;
|
|
|
+ { Retourne le dernier élément de la liste }
|
|
|
+ Function Last: TGIFRenderCacheListItem;
|
|
|
+ { Insertion d'un cache à la position "Index" }
|
|
|
+ Procedure Insert(Index : Integer; AGIFRenderCache : TGIFRenderCacheListItem);
|
|
|
+ { Vérifie si "anIndex" ne dépasse pas la nombre d'élément dans la liste. Retroune FALSE si l'index est hors limite }
|
|
|
+ { Check if 'anIndex' does not exceed the number of items in the list. Retrieve FALSE if the index is out of range }
|
|
|
+ function IsIndexOk(anIndex : Integer) : Boolean;
|
|
|
+ { Supprime les éléments dont le drapeau "IsCorrupted" est vrai }
|
|
|
+ { Remove items wich "IsCorrupted" flag is on True }
|
|
|
+ procedure Pack;
|
|
|
+ { Liste des caches }
|
|
|
+ Property Items[Index: Integer]: TGIFRenderCacheListItem read GetItems write SetItems; Default;
|
|
|
+ End;
|
|
|
+
|
|
|
+ { TGIFAutoStretchMode
|
|
|
+ Mode de redimensionnement automatique}
|
|
|
+ TGIFAutoStretchMode = (smManual, smStretchAll, smStretchOnlyBigger, smStretchOnlySmaller );
|
|
|
+ TOnStretchChanged = procedure (Sender:TObject; IsStretched : Boolean) of object;
|
|
|
+ { TGIFViewer }
|
|
|
+ { Composant visuel pour afficher une image GIF animée }
|
|
|
+ { Visual component for display the animated GIF }
|
|
|
+ TGIFViewer = Class(TGraphicControl)
|
|
|
+ Private
|
|
|
+ FAutoStretchMode: TGIFAutoStretchMode;
|
|
|
+ FGIFLoader: TGIFImageLoader;
|
|
|
+ FLastDrawMode : TGIFDisposalFlag;
|
|
|
+ FFileName: String;
|
|
|
+
|
|
|
+ FRestoreBitmap, FVirtualView: TFastBitmap;
|
|
|
+
|
|
|
+ FRenderCache: TGIFRenderCacheList;
|
|
|
+ FCurrentFrameIndex: Integer;
|
|
|
+ FGIFWidth, FGIFHeight: Integer;
|
|
|
+ FCurrentView: Graphics.TBitmap;
|
|
|
+
|
|
|
+ FAnimateTimer: TTimer;
|
|
|
+ FAnimateSpeed: Integer;
|
|
|
+ FAnimated, FPause: Boolean;
|
|
|
+ FAutoPlay: Boolean;
|
|
|
+ FCache: Boolean;
|
|
|
+
|
|
|
+ FDisplayInvalidFrames : Boolean;
|
|
|
+ FAutoRemoveInvalidFrame : Boolean;
|
|
|
+
|
|
|
+ FPainting: Boolean;
|
|
|
+
|
|
|
+ FBorderShow: Boolean;
|
|
|
+ FBorderColor: TColor;
|
|
|
+ FBorderWidth: Byte;
|
|
|
+ FBevelInner, FBevelOuter: TPanelBevel;
|
|
|
+ FBevelWidth: TBevelWidth;
|
|
|
+ FBevelColor, FColor: TColor;
|
|
|
+
|
|
|
+ FCenter, FStretch, FTransparent: Boolean;
|
|
|
+
|
|
|
+ FOnStart, FOnStop, FOnPause, FOnFrameChange: TNotifyEvent;
|
|
|
+ FOnLoadError : TGIFLoadErrorEvent;
|
|
|
+ FOnStretchChanged : TOnStretchChanged;
|
|
|
+
|
|
|
+ Function GetCanvas: TCanvas;
|
|
|
+ Function GetFrameCount: Integer;
|
|
|
+ Function GetGIFVersion: String;
|
|
|
+ Function GetRawFrameItem(Index : Integer): TGIFImageListItem;
|
|
|
+ Procedure SetAutoStretchMode(AValue: TGIFAutoStretchMode);
|
|
|
+ Procedure SetCenter(Const Value : Boolean);
|
|
|
+ Procedure SetStretch(Const Value : Boolean);
|
|
|
+ Procedure SetPause(Const Value : Boolean);
|
|
|
+ Procedure SetFileName(Const Value : String);
|
|
|
+ Function GetFrame(Const Index : Integer): Graphics.TBitmap;
|
|
|
+ Procedure SetTransparent(Const Value : Boolean);
|
|
|
+ Procedure SetBevelInner(Const Value : TPanelBevel);
|
|
|
+ Procedure SetBevelOuter(Const Value : TPanelBevel);
|
|
|
+ Procedure SetBevelWidth(Const Value : TBevelWidth);
|
|
|
+
|
|
|
+ procedure ResetCurrentView;
|
|
|
+ Protected
|
|
|
+ Procedure DoInternalOnLoadError(Sender : TObject; Const ErrorCount : Integer; Const ErrorList : TStringList);
|
|
|
+ Procedure DoTimerAnimate(Sender : TObject);
|
|
|
+
|
|
|
+ { Rendu d'une image de l'animation }
|
|
|
+ procedure RenderFrame(Index : Integer); Virtual;
|
|
|
+ { Creation des image cache pour l'animation }
|
|
|
+ Procedure ComputeCache; Virtual;
|
|
|
+ { Calcul de la postion et de la dimension pour l'afficchage sur le "Canvas" }
|
|
|
+ Function DestRect: TRect; Virtual;
|
|
|
+
|
|
|
+ { Fonctions hérités }
|
|
|
+ Procedure CalculatePreferredSize(Var PreferredWidth, PreferredHeight : Integer; {%H-}WithThemeSpace : Boolean); Override;
|
|
|
+ Class Function GetControlClassDefaultSize: TSize; Override;
|
|
|
+ Procedure Paint; Override;
|
|
|
+ procedure Loaded; override;
|
|
|
+ procedure BeforeLoad;
|
|
|
+ procedure AfterLoad;
|
|
|
+ Public
|
|
|
+ { Création du composant }
|
|
|
+ Constructor Create(AOwner : TComponent); Override;
|
|
|
+ { Destruction du composant }
|
|
|
+ Destructor Destroy; Override;
|
|
|
+
|
|
|
+ { Mise à jour de la surface de dessin (Canvas) du composant }
|
|
|
+ Procedure Invalidate; Override;
|
|
|
+ { LoadFromStream : Charge les données depuis un flux }
|
|
|
+ Procedure LoadFromStream(aStream : TStream);
|
|
|
+ { Chargement depuis un fichier }
|
|
|
+ Procedure LoadFromFile(Const aFileName : String);
|
|
|
+ { Chargement depuis une Resource Lazarus }
|
|
|
+ Procedure LoadFromResource(Const ResName : String);
|
|
|
+ { Joue l'animation }
|
|
|
+ Procedure Start;
|
|
|
+ { Arrête l'animation }
|
|
|
+ Procedure Stop;
|
|
|
+ { Met en pause l'animation }
|
|
|
+ Procedure Pause;
|
|
|
+ Procedure NextFrame;
|
|
|
+ Procedure PriorFrame;
|
|
|
+ { Retourne l'image brute du GIF à la position Index }
|
|
|
+ Function GetRawFrame(Index : Integer): TBitmap;
|
|
|
+ { Affiche l'image de l'animation mise en cache à la position Index }
|
|
|
+ Procedure DisplayFrame(Index : Integer);
|
|
|
+ { Affiche l'image brute de l'animation à la position Index }
|
|
|
+ Procedure DisplayRawFrame(Index : Integer);
|
|
|
+ { Extrait l'image de l'animation mise en cache à la position Index vers un TBitmap }
|
|
|
+ procedure ExtractFrame(Index : Integer; Var bmp:TBitmap) ;
|
|
|
+ { Extrait l'image brute de l'animation à la position Index vers un TBitmap}
|
|
|
+ procedure ExtractRawFrame(Index : Integer; Var bmp:TBitmap);
|
|
|
+ { Retourne le Canvas du composant }
|
|
|
+ Property Canvas: TCanvas read GetCanvas;
|
|
|
+ { Retourne TRUE si l'animation est en pause }
|
|
|
+ Property Paused: Boolean read FPause;
|
|
|
+ { Retourne TRUE si l'animation est en cours }
|
|
|
+ Property Playing: Boolean read FAnimated;
|
|
|
+ { Retourne l'index actuel de l'image affichée // Current Index of displayed frame }
|
|
|
+ Property CurrentFrameIndex: Integer read FCurrentFrameIndex;
|
|
|
+ { Liste des images de l'animation // List of frame}
|
|
|
+ Property Frames[Index: Integer]: TBitmap read GetFrame;
|
|
|
+ { Retourne le nombre d'image de l'animation // Number of frames }
|
|
|
+ Property FrameCount: Integer read GetFrameCount;
|
|
|
+ { Retourne la version du fichier GIF chargé // version of the gif }
|
|
|
+ Property Version: String read GetGIFVersion;
|
|
|
+ { Image courante de l'animation affichée // Current displayed image }
|
|
|
+ Property CurrentView: Graphics.TBitmap read FCurrentView;
|
|
|
+
|
|
|
+ property RawFrames[Index : Integer] : TGIFImageListItem read GetRawFrameItem;
|
|
|
+ Published
|
|
|
+ Property Color: TColor read FColor write FColor;
|
|
|
+ { Bordure visible autour du composant // Border visible around component }
|
|
|
+ Property Border: Boolean read FBorderShow write FBorderShow;
|
|
|
+ { Couleur de la bordure // Color of border }
|
|
|
+ Property BorderColor: TColor read FBorderColor write FBorderColor;
|
|
|
+ { Epaisseur de la bordure // Width of border }
|
|
|
+ Property BorderWidth: Byte read FBorderWidth write FBorderWidth;
|
|
|
+
|
|
|
+ Property BevelColor: TColor read FBevelColor write FBevelColor;
|
|
|
+ Property BevelInner: TPanelBevel read FBevelInner write SetBevelInner Default bvNone;
|
|
|
+ Property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter Default bvRaised;
|
|
|
+ Property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth Default 1;
|
|
|
+
|
|
|
+ Property Cache: Boolean read FCache write FCache;
|
|
|
+ { Joue l'animation automatiquement lors du chargement d'une image GIF animée }
|
|
|
+ { Play animation automatically when loading an animated GIF image }
|
|
|
+ Property AutoPlay: Boolean read FAutoPlay write FAutoPlay;
|
|
|
+ { Affichage du GIF avec prise en charge de la transparence }
|
|
|
+ { GIF view with transparency support }
|
|
|
+ Property Transparent: Boolean read FTransparent write SetTransparent;
|
|
|
+ { Centrer l'affichage // Center display }
|
|
|
+ Property Center: Boolean read FCenter write SetCenter;
|
|
|
+ { Mode du redimensionnement // Automatic stretch mode
|
|
|
+ smManual : Adpatation Manuelle via la propriété stretch
|
|
|
+ smStretchAll : Adapte toute les images
|
|
|
+ smStretchOnlyBigger : Adapte seulement les images plus grande
|
|
|
+ smStretchOnlySmaller : Adapte seulement les images plus petite
|
|
|
+ }
|
|
|
+ property AutoStretchMode : TGIFAutoStretchMode read FAutoStretchMode write SetAutoStretchMode;
|
|
|
+ { Redimensionner l'affichage proportionnellement // Resize the display proportionally }
|
|
|
+ Property Stretch: Boolean read FStretch write SetStretch;
|
|
|
+ { Nom du fichier à charger // Name of file to load }
|
|
|
+ Property FileName: String read FFileName write SetFileName;
|
|
|
+ { Définis si les images corrompues doivent être affichées. Si le GIF contient que une seule image ce paramètre n'est pas appliqué. Par defaut FALSE }
|
|
|
+ property DisplayInvalidFrames : Boolean read FDisplayInvalidFrames write FDisplayInvalidFrames;
|
|
|
+ { Définis si les images corrompues doivent être effacées de la liste de l'animation automatiquement. Par defaut TRUE }
|
|
|
+ property AutoRemoveInvalidFrame : Boolean Read FAutoRemoveInvalidFrame write FAutoRemoveInvalidFrame;
|
|
|
+
|
|
|
+ { Evènement déclenché lorsque l'animation débute }
|
|
|
+ { Event triggered when the animation starts }
|
|
|
+ Property OnStart: TNotifyEvent read FOnStart write FOnStart;
|
|
|
+ { Evènement déclenché lorsque l'animation s'arrête }
|
|
|
+ { Event triggered when the animation stops }
|
|
|
+ Property OnStop: TNotifyEvent read FOnStop write FOnStop;
|
|
|
+ { Evènement déclenché lorsque l'animation est mise en pause }
|
|
|
+ { Event triggered when the animation is paused }
|
|
|
+ Property OnPause: TNotifyEvent read FOnPause write FOnPause;
|
|
|
+ { Evènement déclenché lorsque une nouvelle image est affiché lors de l'animation }
|
|
|
+ { Event triggered when a new image is displayed during the animation }
|
|
|
+ Property OnFrameChange: TNotifyEvent read FOnFrameChange write FOnFrameChange;
|
|
|
+ { Evenement pour intercepter les erreurs notifiées lors du chargement des données }
|
|
|
+ Property OnLoadError: TGIFLoadErrorEvent read FOnLoadError write FOnLoadError;
|
|
|
+ { Evenement pour intercepter le changement du mode stretch. Uniquement si AutoStretchMode <> smManual }
|
|
|
+ { Event to intercept the change of the stretch mode. Only if AutoStretchMode <> smManual }
|
|
|
+ property OnStretchChanged : TOnStretchChanged read FOnStretchChanged write FOnStretchChanged;
|
|
|
+
|
|
|
+ { Propriétés héritées }
|
|
|
+ Property Align;
|
|
|
+ Property Anchors;
|
|
|
+ Property AutoSize;
|
|
|
+ Property Constraints;
|
|
|
+ Property BorderSpacing;
|
|
|
+ Property Visible;
|
|
|
+ Property ParentShowHint;
|
|
|
+ Property ShowHint;
|
|
|
+ { Evènements héritées }
|
|
|
+ Property OnClick;
|
|
|
+ Property OnMouseDown;
|
|
|
+ Property OnMouseEnter;
|
|
|
+ Property OnMouseLeave;
|
|
|
+ Property OnMouseMove;
|
|
|
+ Property OnMouseUp;
|
|
|
+ Property OnMouseWheel;
|
|
|
+ Property OnMouseWheelDown;
|
|
|
+ Property OnMouseWheelUp;
|
|
|
+
|
|
|
+ End;
|
|
|
+
|
|
|
+ TGIFView = Class(TGIFViewer);
|
|
|
+
|
|
|
+Procedure Register;
|
|
|
+
|
|
|
+Implementation
|
|
|
+
|
|
|
+Uses
|
|
|
+ GraphType;
|
|
|
+
|
|
|
+{$R ../gifview.res}
|
|
|
+
|
|
|
+{%region=====[ Constantes et types internes ]===================================}
|
|
|
+
|
|
|
+
|
|
|
+Type
|
|
|
+ // Statut de décodage / encodage LZW
|
|
|
+ TLZWDecoderStatus = (
|
|
|
+ dsOK, // Tout va bien
|
|
|
+ dsNotEnoughInput, // Tampon d'entrée trop petit
|
|
|
+ dsOutputBufferTooSmall, // Tampon de sortie trop petit
|
|
|
+ dsInvalidInput, // Donnée corrompue
|
|
|
+ dsBufferOverflow, // débordement de tampon
|
|
|
+ dsInvalidBufferSize, // Taille d'un des tampons invalide
|
|
|
+ dsInvalidInputBufferSize, // Taille du tampon d'entrée invalide
|
|
|
+ dsInvalidOutputBufferSize,// Taille du tampon de sortie invalide
|
|
|
+ dsInternalError // Erreur interne signifiant qu'il y a un défaut dans le code
|
|
|
+ );
|
|
|
+
|
|
|
+{%endregion%}
|
|
|
+
|
|
|
+{%region=====[ Fonctions utiles ]===============================================}
|
|
|
+
|
|
|
+Function FixPathDelimiter(S : String): String;
|
|
|
+Var
|
|
|
+ I: Integer;
|
|
|
+Begin
|
|
|
+ Result := S;
|
|
|
+ For I := Length(Result) Downto 1 Do
|
|
|
+ Begin
|
|
|
+ If (Result[I] = '/') Or (Result[I] = '\') Then Result[I] := PathDelim;
|
|
|
+ End;
|
|
|
+End;
|
|
|
+
|
|
|
+Function CreateFileStream(Const fileName : String; mode : Word = fmOpenRead + fmShareDenyNone): TStream;
|
|
|
+Var
|
|
|
+ fn: String;
|
|
|
+Begin
|
|
|
+ fn := filename;
|
|
|
+ FixPathDelimiter(fn);
|
|
|
+ If ((mode And fmCreate) = fmCreate) Or FileExists(fn) Then Result := TFileStream.Create(fn, mode)
|
|
|
+ Else
|
|
|
+ Raise Exception.Create('Fichier non trouvé : "' + fn + '"');
|
|
|
+
|
|
|
+End;
|
|
|
+
|
|
|
+{%endregion%}
|
|
|
+
|
|
|
+{%region=====[ TGIFFastMemoryStream ]==============================================}
|
|
|
+
|
|
|
+Constructor TGIFFastMemoryStream.Create(AStream : TStream);
|
|
|
+Var
|
|
|
+ ms: TMemoryStream;
|
|
|
+Begin
|
|
|
+ ms := TMemoryStream.Create;
|
|
|
+ With ms Do
|
|
|
+ Begin
|
|
|
+ CopyFrom(aStream, 0);
|
|
|
+ Position := 0;
|
|
|
+ End;
|
|
|
+ FSize := ms.Size;
|
|
|
+ FPosition := 0;
|
|
|
+ FBytesLeft := FSize;
|
|
|
+ FBytesRead := 0;
|
|
|
+ FBuffer := nil;
|
|
|
+ ReAllocMem(FBuffer, FSize);
|
|
|
+ Move(PByte(ms.Memory)^, FBuffer^, FSize);
|
|
|
+ FreeAndNil(ms);
|
|
|
+End;
|
|
|
+
|
|
|
+Destructor TGIFFastMemoryStream.Destroy;
|
|
|
+Begin
|
|
|
+ If FBuffer <> nil Then
|
|
|
+ Begin
|
|
|
+ FreeMem(FBuffer);
|
|
|
+ FBuffer := nil;
|
|
|
+ End;
|
|
|
+ Inherited Destroy;
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFFastMemoryStream.ReadByte: Byte;
|
|
|
+Begin
|
|
|
+ Result := 0;
|
|
|
+ If FBytesLeft > 0 Then
|
|
|
+ Begin
|
|
|
+ Result := PByte(FBuffer + FPosition)^;
|
|
|
+ Inc(FPosition);
|
|
|
+ Inc(FBytesRead);
|
|
|
+ Dec(FBytesLeft);
|
|
|
+ End;
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFFastMemoryStream.ReadWord: Word;
|
|
|
+Begin
|
|
|
+ Result := 0;
|
|
|
+ If (FBytesLeft >= 2) Then
|
|
|
+ Begin
|
|
|
+ Result := PWord(FBuffer + FPosition)^;
|
|
|
+ Inc(FPosition, 2);
|
|
|
+ Inc(FBytesRead, 2);
|
|
|
+ Dec(FBytesLeft, 2);
|
|
|
+ End;
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFFastMemoryStream.ReadDWord: DWord;
|
|
|
+Begin
|
|
|
+ Result := 0;
|
|
|
+ If (FBytesLeft >= 4) Then
|
|
|
+ Begin
|
|
|
+ Result := PDWord(FBuffer + FPosition)^;
|
|
|
+ Inc(FPosition, 4);
|
|
|
+ Inc(FBytesRead, 4);
|
|
|
+ Dec(FBytesLeft, 4);
|
|
|
+ End;
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFFastMemoryStream.Read(Var Buffer; Count : Int64): Int64;
|
|
|
+Var
|
|
|
+ NumOfBytesToCopy, NumOfBytesLeft: Longint;
|
|
|
+ CachePtr, BufferPtr: PByte;
|
|
|
+Begin
|
|
|
+ Result := 0;
|
|
|
+
|
|
|
+ If (Count > FBytesLeft) Then NumOfBytesLeft := FBytesLeft
|
|
|
+ Else
|
|
|
+ NumOfBytesLeft := Count;
|
|
|
+
|
|
|
+ BufferPtr := @Buffer;
|
|
|
+
|
|
|
+ While NumOfBytesLeft > 0 Do
|
|
|
+ Begin
|
|
|
+ // On copie les données
|
|
|
+ NumOfBytesToCopy := Min(FSize - FPosition, NumOfBytesLeft);
|
|
|
+ CachePtr := FBuffer;
|
|
|
+ Inc(CachePtr, FPosition);
|
|
|
+
|
|
|
+ Move(CachePtr^, BufferPtr^, NumOfBytesToCopy);
|
|
|
+ Inc(Result, NumOfBytesToCopy);
|
|
|
+ Inc(FPosition, NumOfBytesToCopy);
|
|
|
+ Inc(BufferPtr, NumOfBytesToCopy);
|
|
|
+ // On met à jour les marqueur de notre tampon
|
|
|
+ Inc(FBytesRead, NumOfBytesToCopy);
|
|
|
+ Dec(FBytesLeft, NumOfBytesToCopy);
|
|
|
+ Dec(NumOfBytesLeft, NumOfBytesToCopy);
|
|
|
+
|
|
|
+ End;
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFFastMemoryStream.Seek(Const Offset : Int64; Origin : TSeekOrigin): Int64;
|
|
|
+Var
|
|
|
+ NewPos: Integer;
|
|
|
+Begin
|
|
|
+ // Calcul de la nouvelle position
|
|
|
+ Case Origin Of
|
|
|
+ soBeginning: NewPos := Offset;
|
|
|
+ soCurrent: NewPos := FPosition + Offset;
|
|
|
+ soEnd: NewPos := pred(FSize) - Offset;
|
|
|
+ Else
|
|
|
+ Raise Exception.Create('TFastStream.Seek: Origine Invalide');
|
|
|
+ End;
|
|
|
+ Result := NewPos;
|
|
|
+ If Offset = 0 Then exit;
|
|
|
+
|
|
|
+ FPosition := NewPos;
|
|
|
+ FBytesLeft := FSize - FPosition;
|
|
|
+ Result := NewPos;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFFastMemoryStream.SeekForward(Cnt : Integer);
|
|
|
+Begin
|
|
|
+ Seek(Cnt, soCurrent);
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFFastMemoryStream.EOS: Boolean;
|
|
|
+Begin
|
|
|
+ Result := ((FBytesLeft <= 0) Or (FPosition >= Pred(FSize)));
|
|
|
+End;
|
|
|
+
|
|
|
+{%endregion%}
|
|
|
+
|
|
|
+{%region=====[ TGIFImageListItem ]==============================================}
|
|
|
+
|
|
|
+Constructor TGIFImageListItem.Create;
|
|
|
+Begin
|
|
|
+ FBitmap := TFastBitmap.Create;
|
|
|
+ FLeft := 0;
|
|
|
+ FTop := 0;
|
|
|
+ FDelay := 0;
|
|
|
+ FDrawMode := dmNone;
|
|
|
+ FComment := TStringList.Create;
|
|
|
+ FComment.Clear;
|
|
|
+ FIsCorrupted := False;
|
|
|
+End;
|
|
|
+
|
|
|
+Destructor TGIFImageListItem.Destroy;
|
|
|
+Begin
|
|
|
+ FreeAndNil(FComment);
|
|
|
+ FreeAndNil(FBitmap);
|
|
|
+ Inherited Destroy;
|
|
|
+End;
|
|
|
+
|
|
|
+{%endregion%}
|
|
|
+
|
|
|
+{%region=====[ TGIFImageList ]==================================================}
|
|
|
+
|
|
|
+Function TGIFImageList.GetItems(Index : Integer): TGIFImageListItem;
|
|
|
+Begin
|
|
|
+ Result := TGIFImageListItem(Inherited Items[Index]);
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFImageList.SetItems(Index : Integer; AGifImage : TGIFImageListItem);
|
|
|
+Begin
|
|
|
+ Put(Index, AGifImage);
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFImageList.Clear;
|
|
|
+Var
|
|
|
+ anItem: TGIFImageListItem;
|
|
|
+ i: Integer;
|
|
|
+Begin
|
|
|
+ If Count > 0 Then
|
|
|
+ Begin
|
|
|
+ For i := Count - 1 Downto 0 do
|
|
|
+ Begin
|
|
|
+ AnItem := Items[i];
|
|
|
+ If anItem <> nil Then anItem.Free;
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+ Inherited Clear;
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFImageList.AddNewImage: TGIFImageListItem;
|
|
|
+Var
|
|
|
+ anItem: TGIFImageListItem;
|
|
|
+Begin
|
|
|
+ anitem := TGIFImageListItem.Create;
|
|
|
+ Add(anItem);
|
|
|
+ Result := Items[Self.Count - 1];
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFImageList.Add(AGifImage : TGIFImageListItem): Integer;
|
|
|
+Begin
|
|
|
+ Result := Inherited Add(AGifImage);
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFImageList.Extract(Item : TGIFImageListItem): TGIFImageListItem;
|
|
|
+Begin
|
|
|
+ Result := TGIFImageListItem(Inherited Extract(Item));
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFImageList.Remove(AGifImage : TGIFImageListItem): Integer;
|
|
|
+Begin
|
|
|
+ Result := Inherited Remove(AGifImage);
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFImageList.IndexOf(AGifImage : TGIFImageListItem): Integer;
|
|
|
+Begin
|
|
|
+ Result := Inherited IndexOf(AGifImage);
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFImageList.First: TGIFImageListItem;
|
|
|
+Begin
|
|
|
+ Result := TGIFImageListItem(Inherited First);
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFImageList.Last: TGIFImageListItem;
|
|
|
+Begin
|
|
|
+ Result := TGIFImageListItem(Inherited Last);
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFImageList.Insert(Index : Integer; AGifImage : TGIFImageListItem);
|
|
|
+Begin
|
|
|
+ Inherited Insert(Index, AGifImage);
|
|
|
+End;
|
|
|
+
|
|
|
+{%endregion%}
|
|
|
+
|
|
|
+{%region=====[ TGIFImageLoader ]================================================}
|
|
|
+
|
|
|
+Constructor TGIFImageLoader.Create;
|
|
|
+Begin
|
|
|
+ Inherited Create;
|
|
|
+ FFrames := TGIFImageList.Create(False);
|
|
|
+ FErrorList := TStringList.Create;
|
|
|
+ FErrorCount := 0;
|
|
|
+ FGlobalPalette := nil;
|
|
|
+ FTransparent := True;
|
|
|
+ FBackgroundColor := clrTransparent;
|
|
|
+End;
|
|
|
+
|
|
|
+Destructor TGIFImageLoader.Destroy;
|
|
|
+Begin
|
|
|
+ FreeAndNil(FFrames);
|
|
|
+ FreeAndNil(FErrorList);
|
|
|
+ Inherited Destroy;
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFImageLoader.CheckFormat(): Boolean;
|
|
|
+Begin
|
|
|
+ Result := False;
|
|
|
+ // Chargement de l'en-tête
|
|
|
+ Memory.Read(FGIFFileHeader, SizeOf(TGIFFileHeader));
|
|
|
+ // Vérification de quelques paramètres
|
|
|
+ Result := uppercase(String(FGIFFileHeader.Signature)) = 'GIF';
|
|
|
+ If Result Then
|
|
|
+ Begin
|
|
|
+ // Le fichier est valide
|
|
|
+ // On sauvegarde la version du GIF
|
|
|
+ FVersion := String(FGIFFileHeader.Version);
|
|
|
+ If (FVersion = GIFVersions[gv87a]) Or (FVersion = GIFVersions[gv89a]) Then Result := ReadImageProperties // On lit les propriétés
|
|
|
+ Else
|
|
|
+ Raise Exception.Create(rsUnknownVersion);
|
|
|
+ End
|
|
|
+ Else
|
|
|
+ Begin
|
|
|
+ // Signature du fichier GIF Invalide. On lève une exception
|
|
|
+ Raise Exception.Create(Format(rsBadSignature,[uppercase(String(FGIFFileHeader.Signature))]));
|
|
|
+ End;
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFImageLoader.ReadImageProperties: Boolean;
|
|
|
+Begin
|
|
|
+ Result := False;
|
|
|
+
|
|
|
+ Memory.Read(FLogicalScreenChunk, SizeOf(TGIFLogicalScreenDescriptorRec));
|
|
|
+
|
|
|
+ // On sauvegarde en local les dimensions de l'image, pour plus tard
|
|
|
+ FWidth := FLogicalScreenChunk.ScreenWidth;
|
|
|
+ FHeight := FLogicalScreenChunk.ScreenHeight;
|
|
|
+
|
|
|
+ If (FWidth < 1) Or (FHeight < 1) Then
|
|
|
+ Begin
|
|
|
+ // Dimensions incorrectes on lève une exception
|
|
|
+ Raise Exception.Create(Format(rsBadScreenSize,[FWidth,FHeight]));
|
|
|
+ exit;
|
|
|
+ End;
|
|
|
+ FHasGlobalPalette := (FLogicalScreenChunk.PackedFields And GIF_GLOBALCOLORTABLE) <> 0;
|
|
|
+
|
|
|
+ Result := True;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFImageLoader.AddError(Msg : String);
|
|
|
+Begin
|
|
|
+ FErrorList.Add(Msg);
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFImageLoader.NotifyError;
|
|
|
+Begin
|
|
|
+ If FErrorList.Count > 0 Then
|
|
|
+ Begin
|
|
|
+ If Assigned(FOnLoadError) Then FOnLoadError(Self, FErrorList.Count, FErrorList);
|
|
|
+ End;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFImageLoader.LoadFromStream(aStream : TStream);
|
|
|
+Begin
|
|
|
+ If Memory <> nil Then FreeAndNil(Memory);
|
|
|
+ Memory := TGIFFastMemoryStream.Create(aStream);
|
|
|
+ If CheckFormat Then LoadFromMemory;
|
|
|
+ FreeAndNil(Memory);
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFImageLoader.LoadFromFile(Const FileName : String);
|
|
|
+Var
|
|
|
+ Stream: TStream;
|
|
|
+Begin
|
|
|
+ FErrorList.Clear;
|
|
|
+ FErrorCOunt := 0;
|
|
|
+ Stream := CreateFileStream(FileName);
|
|
|
+ Try
|
|
|
+ LoadFromStream(Stream);
|
|
|
+ Finally
|
|
|
+ FreeAndNil(Stream);
|
|
|
+ End;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFImageLoader.LoadFromResource(Const ResName : String);
|
|
|
+Var
|
|
|
+ Stream: TLazarusResourceStream;
|
|
|
+Begin
|
|
|
+ FErrorList.Clear;
|
|
|
+ FErrorCOunt := 0;
|
|
|
+ Stream := TLazarusResourceStream.Create(ResName, nil);
|
|
|
+ Try
|
|
|
+ LoadFromStream(Stream);
|
|
|
+ Finally
|
|
|
+ FreeAndNil(Stream);
|
|
|
+ End;
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFImageLoader.GetFrameCount: Integer;
|
|
|
+Begin
|
|
|
+ Result := FFrames.Count;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFImageLoader.SetCurrentLayerIndex(AValue : Integer);
|
|
|
+Begin
|
|
|
+ If FCurrentLayerIndex = AValue Then Exit;
|
|
|
+ FCurrentLayerIndex := AValue;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFImageLoader.LoadFromMemory();
|
|
|
+Var
|
|
|
+ aRGBColor: TColorRGB24;
|
|
|
+ aColor: TColor32;
|
|
|
+ PaletteCount: Integer;
|
|
|
+ Done: Boolean;
|
|
|
+ BlockID: Byte;
|
|
|
+ BlockSize: Byte;
|
|
|
+ Terminator{%H-}: Byte;
|
|
|
+ CurrentLayer: TGIFImageListItem;
|
|
|
+
|
|
|
+ ImageDescriptor: TGIFImageDescriptorRec;
|
|
|
+ GraphicControlExtensionChunk: TGIFGraphicControlExtensionRec;
|
|
|
+ ApplicationExtensionChunk: TGIFApplicationExtensionRec;
|
|
|
+ NSLoopExtensionChunk: TGIFNSLoopExtensionRec;
|
|
|
+ PlainTextChunk: TGIFPlainTextExtensionRec;
|
|
|
+
|
|
|
+ LocalPalette: TColor32List;
|
|
|
+ ColorCount: Integer;
|
|
|
+ DMode: Byte;
|
|
|
+ ret: TLZWDecoderStatus;
|
|
|
+
|
|
|
+ { Chargement palette globale }
|
|
|
+ Procedure LoadGlobalPalette;
|
|
|
+ Var
|
|
|
+ J: Byte;
|
|
|
+ Begin
|
|
|
+ If FHasGlobalPalette Then
|
|
|
+ Begin
|
|
|
+ // Remise à zero de la palette globale si elle existe sinon création de celle-ci
|
|
|
+ If FGlobalPalette = nil Then FGlobalPalette := TColor32List.Create
|
|
|
+ Else
|
|
|
+ FGlobalPalette.Clear;
|
|
|
+
|
|
|
+ PaletteCount := 2 Shl (FLogicalScreenChunk.PackedFields And GIF_COLORTABLESIZE);
|
|
|
+ // Le cas ou le nombre de couleurs serait plus grand que 256. On prend en charge.
|
|
|
+ If (PaletteCount < 2) Then //or (PaletteCount>256) then
|
|
|
+ Raise Exception.Create(rsScreenBadColorSize + ' : ' + IntToStr(PaletteCount));
|
|
|
+
|
|
|
+ // On charge la palette
|
|
|
+ For J := 0 To PaletteCount - 1 Do
|
|
|
+ Begin
|
|
|
+ Memory.Read(aRGBColor, SizeOF(TColorRGB24));
|
|
|
+ aColor.Create(aRGBColor);
|
|
|
+ FGlobalPalette.AddColor(aColor);
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+
|
|
|
+ { Chargement palette locale }
|
|
|
+ Procedure LoadLocalPalette;
|
|
|
+ Var
|
|
|
+ J: Byte;
|
|
|
+ Begin
|
|
|
+ // Aucune palette locale n'a été assignée. On en créer une nouvelle. Sinon on efface simplement son contenu.
|
|
|
+ If LocalPalette = nil Then LocalPalette := TColor32List.Create
|
|
|
+ Else
|
|
|
+ LocalPalette.Clear;
|
|
|
+
|
|
|
+ // On verifie que le nombre de couleur dans la palette est correcte
|
|
|
+ ColorCount := (2 Shl (ImageDescriptor.PackedFields And GIF_COLORTABLESIZE));
|
|
|
+ // Le cas ou le nombre de couleurs serait plus grand que 256. On prend en charge qudn même et on charge la palette.
|
|
|
+ If (ColorCount < 2) Then //or (ColorCount>256) then
|
|
|
+ Raise Exception.Create(rsImageBadColorSize + ' : ' + IntToStr(ColorCount));
|
|
|
+
|
|
|
+ // On charge la palette
|
|
|
+ For J := 0 To ColorCount - 1 Do
|
|
|
+ Begin
|
|
|
+ Memory.Read(aRGBColor, SizeOF(TColorRGB24));
|
|
|
+ aColor.Create(aRGBColor);
|
|
|
+ LocalPalette.AddColor(aColor);
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+
|
|
|
+ { Lecture des extensions }
|
|
|
+ Procedure ReadExtension;
|
|
|
+ Var
|
|
|
+ ExtensionID, BlockType: Byte;
|
|
|
+ BufStr: Array[0..255] Of Char;
|
|
|
+ Loops: Word;
|
|
|
+ CurrentExtension : String;
|
|
|
+ Begin
|
|
|
+ // On lit les extension jusqu'a ce qu'un bloc de description d'une image soit détecter ou que jusqu'a la fin du fichier
|
|
|
+ Repeat
|
|
|
+ //showmessage('Read extension at '+ Memory.Position.ToString);
|
|
|
+ ExtensionID := Memory.ReadByte;
|
|
|
+ CurrentExtension :='';
|
|
|
+ // Si c'est un nouveau marqueur d'introduction d'extension. On lit le nouvel ID
|
|
|
+ If (ExtensionID = GIF_EXTENSIONINTRODUCER) Then ExtensionID := Memory.ReadByte;
|
|
|
+ If (ExtensionID = 0) Then
|
|
|
+ Begin
|
|
|
+ // On Saute les ID Nul
|
|
|
+ Repeat
|
|
|
+ ExtensionID := Memory.ReadByte;
|
|
|
+ Until (ExtensionID <> 0);
|
|
|
+ End;
|
|
|
+ Case ExtensionID Of
|
|
|
+ GIF_PLAINTEXT:
|
|
|
+ Begin
|
|
|
+ BlockSize := Memory.ReadByte;
|
|
|
+ Memory.Read(PlainTextChunk, SizeOf(TGIFPlainTextExtensionRec));
|
|
|
+ Repeat
|
|
|
+ // On lit la taille du bloc. Si Zero alors fin des données de l'extension
|
|
|
+ BlockSize := Memory.ReadByte;
|
|
|
+ // On lit la chaine de caractères
|
|
|
+ If (BlockSize > 0) Then
|
|
|
+ Begin
|
|
|
+ fillchar({%H-}BufStr, 256, 0);
|
|
|
+ Memory.Read(BufStr, BlockSize);
|
|
|
+ BufStr[BlockSize] := #0;
|
|
|
+ // On place le texte dans les commentaires
|
|
|
+ CurrentLayer.Comment.Add(String(BufStr));
|
|
|
+ End;
|
|
|
+ Until (BlockSize = 0);
|
|
|
+ // On ajoute une ligne vide de séparation
|
|
|
+ CurrentLayer.Comment.Add('');
|
|
|
+ End;
|
|
|
+ GIF_COMMENTEXTENSION:
|
|
|
+ Begin
|
|
|
+ Repeat
|
|
|
+ // On lit la taille du commentaire. Si Zero alors fin des données de l'extension
|
|
|
+ BlockSize := Memory.ReadByte;
|
|
|
+ // On lit la chaine de caractères
|
|
|
+ If (BlockSize > 0) Then
|
|
|
+ Begin
|
|
|
+ Memory.Read(BufStr, BlockSize);
|
|
|
+ BufStr[BlockSize] := #0;
|
|
|
+ // On place le texte dans les commentaires
|
|
|
+ CurrentLayer.Comment.Add(String(BufStr));
|
|
|
+ End;
|
|
|
+ Until (BlockSize <= 0);
|
|
|
+ // On ajoute une ligne vide de séparation
|
|
|
+ CurrentLayer.Comment.Add('');
|
|
|
+ End;
|
|
|
+ GIF_APPLICATIONEXTENSION:
|
|
|
+ Begin
|
|
|
+
|
|
|
+ BlockSize := Memory.ReadByte;
|
|
|
+ // Certains vieux filtres d'exportation Adobe, ou d'autres logiciels utilisent par erreur une valeur de 10, ou plus petite ou trop grande
|
|
|
+ If (BlockSize <> 11) Then
|
|
|
+ Begin
|
|
|
+ FillChar(ApplicationExtensionChunk, SizeOf(TGIFApplicationExtensionRec), 0);
|
|
|
+ End;
|
|
|
+ //else if (BlockSize<11) then
|
|
|
+ // Raise Exception.Create('Bad extension size' + ' : ' + inttostr(BlockSize) +' octets. ( Taille valide = 11 octets )');
|
|
|
+ Memory.Read(ApplicationExtensionChunk, SizeOf(TGIFApplicationExtensionRec));
|
|
|
+ CurrentExtension := ApplicationExtensionChunk.AppAuthenticationCode;
|
|
|
+ Repeat
|
|
|
+ // On lit la taille du bloc. Zero si il n'y a pas de données supplémentaires
|
|
|
+ BlockSize := Memory.ReadByte;
|
|
|
+ If (BlockSize > 0) Then
|
|
|
+ Begin
|
|
|
+ if UpperCase(CurrentExtension) = 'NETSCAPE' then
|
|
|
+ begin
|
|
|
+ BlockType := Memory.ReadByte;
|
|
|
+ Dec(BlockSize);
|
|
|
+ Case (BlockType And $07) Of
|
|
|
+ GIF_LOOPEXTENSION:
|
|
|
+ Begin
|
|
|
+ // Lecture du nombre de boucle, Si Zero alors boucle infinie
|
|
|
+ Loops := Memory.ReadWord;
|
|
|
+ If Loops > 0 Then Inc(NSLoopExtensionChunk.Loops);
|
|
|
+ Dec(BlockSize, SizeOf(Loops));
|
|
|
+ End;
|
|
|
+ GIF_BUFFEREXTENSION:
|
|
|
+ Begin
|
|
|
+ // Lecture de la taille du tampon. Utilisé pour ??????
|
|
|
+ NSLoopExtensionChunk.BufferSize := Memory.ReadDWord;
|
|
|
+ Dec(BlockSize, SizeOF(NSLoopExtensionChunk.BufferSize));
|
|
|
+ End;
|
|
|
+ else // Extension NETSCAPE inconnue
|
|
|
+ begin
|
|
|
+ Memory.SeekForward(BlockSize);
|
|
|
+ //BlockSize := 0;
|
|
|
+ end;
|
|
|
+ End;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ // On saute et on ignore les donnée non lues
|
|
|
+ If (BlockSize > 0) Then
|
|
|
+ Begin
|
|
|
+ Memory.SeekForward(BlockSize);
|
|
|
+ //BlockSize := 0;
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+ Until (BlockSize = 0);
|
|
|
+ End;
|
|
|
+ GIF_GRAPHICCONTROLEXTENSION:
|
|
|
+ Begin
|
|
|
+ // On lit la taille de l'extension. Normalement 4 Octets. Cette valeur peut-être erronée. On en tient pas compte ici et on lit les données.
|
|
|
+ BlockSize := Memory.ReadByte;
|
|
|
+ //if BlockSize = 4 then
|
|
|
+ //begin
|
|
|
+ Memory.Read(GraphicControlExtensionChunk, SizeOf(TGIFGraphicControlExtensionRec));
|
|
|
+ // On renseigne notre tampon d'informations pour les prochaines images décodées
|
|
|
+ DMode := ((GraphicControlExtensionChunk.PackedFields And GIF_DISPOSAL_ALL) Shr 2);
|
|
|
+ With CurrentFrameInfos Do
|
|
|
+ Begin
|
|
|
+ // Ces valeurs peuvent être utilisées pour plusieurs image. Elles restent valides jusqu'a la lecture du prochain "GCE" trouvé.
|
|
|
+ Disposal := TGIFDisposalFlag(DMode);
|
|
|
+ IsTransparent := (GraphicControlExtensionChunk.PackedFields And GIF_TRANSPARENT_FLAG) <> 0;
|
|
|
+ UserInput := (GraphicControlExtensionChunk.PackedFields And GIF_USER_INPUT_FLAG) <> 0;
|
|
|
+ TransparentColorIndex := GraphicControlExtensionChunk.TransparentColorIndex;
|
|
|
+ BackgroundColorIndex := FLogicalScreenChunk.BackgroundColorIndex;
|
|
|
+ DelayTime := GraphicControlExtensionChunk.DelayTime;
|
|
|
+ End;
|
|
|
+ // Lecture de l'octet de fin de l'extension
|
|
|
+ Terminator := Memory.ReadByte;
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+ Until (ExtensionID = GIF_IMAGEDESCRIPTOR) Or Memory.EOS;
|
|
|
+
|
|
|
+ // Si l'ID pour la description de l'image est détecter on revient en arrière pour la prise en charge par le traitement des données
|
|
|
+ If (ExtensionID = GIF_IMAGEDESCRIPTOR) Then Memory.Seek(-1, soCurrent);
|
|
|
+ End;
|
|
|
+
|
|
|
+ { Chargement d'une image }
|
|
|
+ Procedure LoadImage;
|
|
|
+ Var
|
|
|
+ DecoderStatus{%H-}: TLZWDecoderStatus;
|
|
|
+ BufferSize, TargetBufferSize, BytesRead: Int64;
|
|
|
+ InitCodeSize: Byte;
|
|
|
+ OldPosition: Int64;
|
|
|
+ Buffer, BufferPtr: PByte;
|
|
|
+ TargetBuffer, TargetBufferPtr: PByte;
|
|
|
+ LinePtr: PColor32;
|
|
|
+ Pass, Increment: Byte;
|
|
|
+ x: Integer;
|
|
|
+ TargetColor: TColor32;
|
|
|
+ ColIdx: Byte;
|
|
|
+ CurrentLine: Integer;
|
|
|
+ OutBmp: TFastBitmap;
|
|
|
+
|
|
|
+ // Decodeur GIF LZW. Basé sour le code source de la bibliothèque GraphicEX pour Delphi
|
|
|
+ Function DecodeLZW(Var Source, Dest : Pointer; PackedSize, UnpackedSize : Integer): TLZWDecoderStatus;
|
|
|
+ Const
|
|
|
+ { Constantes pour la décompression LZW }
|
|
|
+ _LZWGIFCodeBits = 12; // Nombre maximal de bits par code d'un jeton (12 bits = 4095)
|
|
|
+ _LZWGIFCodeMax = 4096; // Nombre maximum de jeton
|
|
|
+ _LZWGIFStackSize = (2 Shl _LZWGIFCodeBits); // Taille de la pile de décompression
|
|
|
+ _LZWGIFTableSize = (1 Shl _LZWGIFCodeBits); // Taille de la table de décompression
|
|
|
+
|
|
|
+ Var
|
|
|
+ J: Integer;
|
|
|
+ Data, // Données actuelle
|
|
|
+ Bits, // Compteur de bit
|
|
|
+ Code: Cardinal; // Valeur courrante du Code
|
|
|
+ SourcePtr: PByte;
|
|
|
+ InCode: Cardinal; // Tampon pour passé le Code
|
|
|
+
|
|
|
+ CodeSize: Cardinal;
|
|
|
+ CodeMask: Cardinal;
|
|
|
+ FreeCode: Cardinal;
|
|
|
+ OldCode: Cardinal;
|
|
|
+ Prefix: Array[0.._LZWGIFTableSize] Of Cardinal; // LZW prefix
|
|
|
+ Suffix, // LZW suffix
|
|
|
+ Stack: Array [0.._LZWGIFStackSize] Of Byte;
|
|
|
+ StackPointer: PByte;
|
|
|
+ MaxStackPointer: PBYte;
|
|
|
+ Target: PByte;
|
|
|
+ FirstChar: Byte; // Tampon de décodage d'un octet
|
|
|
+ ClearCode, EOICode: Word;
|
|
|
+ MaxCode: Boolean;
|
|
|
+
|
|
|
+ Begin
|
|
|
+ Result := dsOk;
|
|
|
+ DecoderStatus := dsOk;
|
|
|
+ If (PackedSize <= 0) Or (UnpackedSize <= 0) Then
|
|
|
+ Begin
|
|
|
+ // Taille des tampons invalides
|
|
|
+ If (PackedSize <= 0) And (UnpackedSize <= 0) Then Result := dsInvalidBufferSize
|
|
|
+ Else If PackedSize <= 0 Then Result := dsInvalidInputBufferSize
|
|
|
+ Else If UnpackedSize <= 0 Then Result := dsInvalidOutputBufferSize;
|
|
|
+ Exit;
|
|
|
+ End;
|
|
|
+
|
|
|
+ // Initialisation des paramètres pour la décompression
|
|
|
+ CodeSize := InitCodeSize + 1;
|
|
|
+ ClearCode := 1 Shl InitCodeSize;
|
|
|
+ EOICode := ClearCode + 1;
|
|
|
+ FreeCode := ClearCode + 2;
|
|
|
+ OldCode := _LZWGIFCodeMax - 1;
|
|
|
+ CodeMask := (1 Shl CodeSize) - 1;
|
|
|
+ MaxCode := False;
|
|
|
+ Code := 0;
|
|
|
+ Target := PByte(Dest);
|
|
|
+ SourcePtr := PByte(Source);
|
|
|
+
|
|
|
+ // Initialisation des tables de Code
|
|
|
+ For J := 0 To _LZWGIFTableSize Do
|
|
|
+ Begin
|
|
|
+ Prefix[J] := _LZWGIFCodeMax;
|
|
|
+ Suffix[J] := J;
|
|
|
+ End;
|
|
|
+
|
|
|
+ // Initalisation de la pile
|
|
|
+ StackPointer := @Stack;
|
|
|
+ MaxStackPointer := @Stack[_LZWGIFStackSize];
|
|
|
+ FirstChar := 0;
|
|
|
+
|
|
|
+ Data := 0;
|
|
|
+ Bits := 0;
|
|
|
+ While (UnpackedSize > 0) And (PackedSize > 0) Do
|
|
|
+ Begin
|
|
|
+ // On lit le "Code" dans le tampon d'entrée
|
|
|
+ Inc(Data, SourcePtr^ Shl Bits);
|
|
|
+ Inc(Bits, 8);
|
|
|
+ While (Bits > CodeSize) And (UnpackedSize > 0) Do
|
|
|
+ Begin
|
|
|
+ // Code actuel
|
|
|
+ Code := Data And CodeMask;
|
|
|
+ // Préparation pour la donnée suivante
|
|
|
+ Data := Data Shr CodeSize;
|
|
|
+ Dec(Bits, CodeSize);
|
|
|
+
|
|
|
+ // Décompression finie ?
|
|
|
+ If Code = EOICode Then
|
|
|
+ Begin
|
|
|
+ // Si nous arrivons ici, il y a probablement quelque chose de suspect avec l'image GIF
|
|
|
+ // Car normalement on stoppe dès que le tampon de sortie est plein.
|
|
|
+ // Cela signifie que nous ne lirons jamais l'EOICode de fermeture dans les images normales.
|
|
|
+ // Comme l'état du buffer est déjà vérifié après la boucle principale, nous ne le ferons pas ici.
|
|
|
+ Break;
|
|
|
+ End;
|
|
|
+
|
|
|
+ // On vérifie s'il s'agit d'un code valide déjà enregistré
|
|
|
+ If Code > FreeCode Then
|
|
|
+ Begin
|
|
|
+ // Code ne peux à être supérieur à FreeCode. Nous avons donc une image cassée.
|
|
|
+ // On notifie l'erreur à l'utilisateur. Et on considère qu'il n'ya pas d'erreur.
|
|
|
+ DecoderStatus := dsInvalidInput;
|
|
|
+ AddError(Format(rsLZWInvalidInput,[CurrentFrameIndex]));
|
|
|
+ //NotifyUser('Le décodeur a rencontré une entrée invalide (données corrompues)');
|
|
|
+ Code := ClearCode;
|
|
|
+ //Break; //Ici, on continue le chargement du reste de l'image au lieu de le stopper
|
|
|
+ End;
|
|
|
+
|
|
|
+ // RAZ
|
|
|
+ If Code = ClearCode Then
|
|
|
+ Begin
|
|
|
+ // réinitialisation de toutes les variables
|
|
|
+ CodeSize := InitCodeSize + 1;
|
|
|
+ CodeMask := (1 Shl CodeSize) - 1; //CodeMasks[CodeSize];
|
|
|
+ FreeCode := ClearCode + 2;
|
|
|
+ OldCode := _LZWGIFCodeMax;
|
|
|
+ MaxCode := False;
|
|
|
+ End
|
|
|
+ Else If OldCode = _LZWGIFCodeMax Then
|
|
|
+ Begin
|
|
|
+ // Gestion du premier Code LZW : On le définit dans le tampon de sortie et on le conserve
|
|
|
+ FirstChar := Suffix[Code];
|
|
|
+ Target^ := FirstChar;
|
|
|
+ Inc(Target);
|
|
|
+ Dec(UnpackedSize);
|
|
|
+ OldCode := Code;
|
|
|
+ End
|
|
|
+ Else
|
|
|
+ Begin
|
|
|
+ //On conserve le Code LZW actuel
|
|
|
+ InCode := Code;
|
|
|
+
|
|
|
+ // On place le nouveau code LZW sur la pile sauf quand nous avons déjà utilisé tous les codes disponibles
|
|
|
+ If (Code = FreeCode) And Not MaxCode Then
|
|
|
+ Begin
|
|
|
+ StackPointer^ := FirstChar;
|
|
|
+ Inc(StackPointer);
|
|
|
+ Code := OldCode;
|
|
|
+ End;
|
|
|
+
|
|
|
+ // boucle pour placer les octets décodés sur la pile
|
|
|
+ While Code > ClearCode Do
|
|
|
+ Begin
|
|
|
+ StackPointer^ := Suffix[Code];
|
|
|
+ If StackPointer >= MaxStackPointer Then
|
|
|
+ Begin
|
|
|
+ // Ne doit jamais arriver, c'est juste une précaution au cas ou.
|
|
|
+ Result := dsBufferOverflow;
|
|
|
+ break;
|
|
|
+ End;
|
|
|
+ Inc(StackPointer);
|
|
|
+ Code := Prefix[Code];
|
|
|
+ End;
|
|
|
+ If Result <> dsOK Then break; // Si il ya eu des erreurs on ne va pas plus loin
|
|
|
+
|
|
|
+ // Place le nouveau Code dans la table
|
|
|
+ FirstChar := Suffix[Code];
|
|
|
+ StackPointer^ := FirstChar;
|
|
|
+ Inc(StackPointer);
|
|
|
+
|
|
|
+ //Transfert des données décodées vers notre tampon de sortie
|
|
|
+ Repeat
|
|
|
+ If UnpackedSize <= 0 Then
|
|
|
+ Begin
|
|
|
+ // Le tampon de sortie est trop petit. On ne va pas plus loin
|
|
|
+ // On notifie l'erreur à l'utilisateur. Et on considère qu'il n'ya pas d'erreur.
|
|
|
+ // Afin de pouvoir afficher le GIF et continuer le chargement des images suivantes
|
|
|
+ Result := dsOutputBufferTooSmall;
|
|
|
+ AddError(Format(rsLZWOutputBufferTooSmall,[CurrentFrameIndex]));
|
|
|
+ break;
|
|
|
+ End;
|
|
|
+ Dec(StackPointer);
|
|
|
+ Target^ := StackPointer^;
|
|
|
+ Inc(Target);
|
|
|
+ Dec(UnpackedSize);
|
|
|
+ Until StackPointer = @Stack;
|
|
|
+ If Result <> dsOK Then break;
|
|
|
+
|
|
|
+ If Not MaxCode Then
|
|
|
+ Begin
|
|
|
+ If FreeCode <= _LZWGIFCodeMax Then
|
|
|
+ Begin
|
|
|
+ Prefix[FreeCode] := OldCode;
|
|
|
+ Suffix[FreeCode] := FirstChar;
|
|
|
+ End
|
|
|
+ Else If FreeCode > _LZWGIFCodeMax Then
|
|
|
+ Begin
|
|
|
+ // On a intercepter une donnée corrompue. On continue quand la même décompression sans en tenir compte.
|
|
|
+ // On notifie juste l'erreur à l'utilisateur
|
|
|
+ DecoderStatus := dsInvalidInput;
|
|
|
+ AddError(Format(rsLZWInvalidInput,[CurrentFrameIndex]));
|
|
|
+ FreeCode := _LZWGIFCodeMax;
|
|
|
+ Prefix[FreeCode] := OldCode;
|
|
|
+ Suffix[FreeCode] := FirstChar;
|
|
|
+ //MaxCode := True;
|
|
|
+ End;
|
|
|
+
|
|
|
+ // On augmente la taille du Code si nécessaire
|
|
|
+ If (FreeCode = CodeMask) And Not (MaxCode) Then
|
|
|
+ Begin
|
|
|
+ If (CodeSize < _LZWGIFCodeBits) Then
|
|
|
+ Begin
|
|
|
+ Inc(CodeSize);
|
|
|
+ CodeMask := (1 Shl CodeSize) - 1;//CodeMasks[CodeSize];
|
|
|
+ End
|
|
|
+ Else //On a atteind la limite maximum
|
|
|
+ MaxCode := True;
|
|
|
+ End;
|
|
|
+
|
|
|
+ If FreeCode < _LZWGIFTableSize Then Inc(FreeCode);
|
|
|
+ End;
|
|
|
+ OldCode := InCode;
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+ Inc(SourcePtr);
|
|
|
+ Dec(PackedSize);
|
|
|
+ If (Result <> dsOK) Or (Code = EOICode) Then Break;
|
|
|
+ End;
|
|
|
+
|
|
|
+ If Result = dsOK Then
|
|
|
+ Begin
|
|
|
+ // On vérifie seulement si il n'ya pas eu d'erreur. Si ce n'est pas le cas, nous savons déjà que quelque chose ne va pas.
|
|
|
+ // Notez qu'il est normal que PackedSize soit un peu> 0 parce que nous pouvons
|
|
|
+ // pas lire l'EOICode mais arrêter dès que notre tampon de sortie est plein et
|
|
|
+ // qui devrait normalement être le code juste avant l'EOICode.
|
|
|
+ If PackedSize < 0 Then
|
|
|
+ Begin
|
|
|
+ Result := dsInternalError;
|
|
|
+ // C'est une erreur sérieuse : nous avons eu un dépassement de tampon d'entrée que nous aurions dû intercepter. Nous devons arrêter maintenant.
|
|
|
+ Raise Exception.Create(rsLZWInternalErrorInputBufferOverflow);
|
|
|
+ Exit;
|
|
|
+ End;
|
|
|
+ If UnpackedSize <> 0 Then
|
|
|
+ Begin
|
|
|
+ //if UnpackedSize > 0 then
|
|
|
+ //begin
|
|
|
+ // // Image corrompue
|
|
|
+ // DecoderStatus := dsNotEnoughInput;
|
|
|
+ // AddError('Image #'+CurrentFrameIndex)+' : Le décodeur n''a pas pu décoder toutes les données car le tampon d''entrée est trop petit');
|
|
|
+ // //NotifyUser('Le décodeur n''a pas pu décoder toutes les données car le tampon d''entrée est trop petit');
|
|
|
+ //End
|
|
|
+ //else
|
|
|
+ If UnpackedSize < 0 Then
|
|
|
+ Begin
|
|
|
+ Result := dsInternalError;
|
|
|
+ // C'est une erreur sérieuse : nous avons eu un dépassement de tampon de sortie que nous aurions dû intercepter. Nous devons arrêter maintenant.
|
|
|
+ Raise Exception.Create(rsLZWInternalErrorOutputBufferOverFlow);
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+
|
|
|
+ Begin
|
|
|
+ BufferSize := 0;
|
|
|
+ TargetBufferSize := 0;
|
|
|
+
|
|
|
+ // On lit la description de l'image
|
|
|
+ Memory.Read(ImageDescriptor, SizeOf(TGIFImageDescriptorRec));
|
|
|
+
|
|
|
+ // On vérifie que les dimensions sont correctes.
|
|
|
+ // Si on trouve des dimensions à zero, il se peut qu'il faudra traiter
|
|
|
+ // une extension PlainText et dessiner ce texte en fonction des paramètres
|
|
|
+ If (ImageDescriptor.Height = 0) Or (ImageDescriptor.Width = 0) Then
|
|
|
+ Begin
|
|
|
+ // On assigne les dimensions par défaut du GIF
|
|
|
+ ImageDescriptor.Width := FLogicalScreenChunk.ScreenWidth;
|
|
|
+ ImageDescriptor.Height := FLogicalScreenChunk.ScreenHeight;
|
|
|
+ // On notifie à l'utilisateur que les dimensions de l'image sont erronée. Mais on tente le chargement quand même
|
|
|
+ // ShowMessage
|
|
|
+ End;
|
|
|
+
|
|
|
+ // Dans le cas ou les dimensions de l'image sont incorrectes dans "l'image descriptor". Ou que la taille des données compressées soit erronée.
|
|
|
+ If (ImageDescriptor.Width > FLogicalScreenChunk.ScreenWidth) Or (ImageDescriptor.Height > FLogicalScreenChunk.ScreenHeight) Then
|
|
|
+ Begin
|
|
|
+ // On assigne les dimensions par défaut du GIF
|
|
|
+ If (ImageDescriptor.Width > FLogicalScreenChunk.ScreenWidth) Then ImageDescriptor.Width := FLogicalScreenChunk.ScreenWidth;
|
|
|
+ If (ImageDescriptor.Height > FLogicalScreenChunk.ScreenHeight) Then ImageDescriptor.Height := FLogicalScreenChunk.ScreenHeight;
|
|
|
+ // On notifie à l'utilisateur que les dimensions de l'image sont erronée. Mais on tente le chargement quand même
|
|
|
+ // ShowMessage
|
|
|
+ End;
|
|
|
+
|
|
|
+ // On renseigne notre tampon d'informations
|
|
|
+ With CurrentFrameInfos Do
|
|
|
+ Begin
|
|
|
+ Left := ImageDescriptor.Left;
|
|
|
+ Top := ImageDescriptor.Top;
|
|
|
+ Width := ImageDescriptor.Width;
|
|
|
+ Height := ImageDescriptor.Height;
|
|
|
+ Interlaced := (ImageDescriptor.PackedFields And GIF_INTERLACED) = GIF_INTERLACED;
|
|
|
+ HasLocalPalette := (ImageDescriptor.PackedFields And GIF_LOCALCOLORTABLE) = GIF_LOCALCOLORTABLE;
|
|
|
+ End;
|
|
|
+
|
|
|
+ // L'image possède-t-elle sa propre palette de couleur ? Si oui on la charge.
|
|
|
+ If CurrentFrameInfos.HasLocalPalette Then LoadLocalPalette;
|
|
|
+
|
|
|
+ // Decompression de l'image
|
|
|
+
|
|
|
+ // On ajoute une nouvelle image si besoin
|
|
|
+ If (FCurrentLayerIndex > 0) And (FCurrentLayerIndex > FFrames.Count - 1) Then CurrentLayer := FFrames.AddNewImage;
|
|
|
+ // On assigne la nouvelle image au Bitmap de travail
|
|
|
+ OutBmp := FFrames.Items[CurrentFrameIndex].Bitmap;
|
|
|
+
|
|
|
+ // On met à jour les informations
|
|
|
+ With FFrames.Items[FCurrentLayerIndex] Do
|
|
|
+ Begin
|
|
|
+ Drawmode := CurrentFrameInfos.Disposal;
|
|
|
+ // Showmessage('#'+inttostr(FCurrentLayerIndex) + 'DrawMode : '+ GifGCEDisposalModeStr[Drawmode]);
|
|
|
+ Left := CurrentFrameInfos.Left;
|
|
|
+ Top := CurrentFrameInfos.Top;
|
|
|
+ IsTransparent := CurrentFrameInfos.IsTransparent;
|
|
|
+ If CurrentFrameInfos.DelayTime = 0 Then Delay := GIF_DefaultDelay
|
|
|
+ Else
|
|
|
+ Delay := CurrentFrameInfos.DelayTime * GIF_DelayFactor;
|
|
|
+ End;
|
|
|
+
|
|
|
+ // On lit le code d'initalisation de la compression LZW
|
|
|
+ InitCodeSize := Memory.ReadByte;
|
|
|
+ If InitCodeSize < 2 Then InitCodeSize := 2;
|
|
|
+ If InitCodeSize > 8 Then InitCodeSize := 8;
|
|
|
+
|
|
|
+ // On sauve la position actuelle dans le flux
|
|
|
+ OldPosition := Memory.position;
|
|
|
+
|
|
|
+ BufferSize := 0;
|
|
|
+
|
|
|
+ // 1) On comptabilise la taille totale des données compresser. Afin de les décompresser en une seule fois.
|
|
|
+ // On lit la taille du premier bloc
|
|
|
+ BlockSize := Memory.ReadByte;
|
|
|
+ While (BlockSize > 0) And Not (Memory.EOS) Do
|
|
|
+ Begin
|
|
|
+ Inc(BufferSize, BlockSize);
|
|
|
+ // On saute les données
|
|
|
+ Memory.SeekForward(BlockSize);
|
|
|
+ If Not (Memory.EOS) Then BlockSize := Memory.ReadByte
|
|
|
+ Else
|
|
|
+ blocksize := 0;
|
|
|
+ End;
|
|
|
+
|
|
|
+ // 2) On initalise notre bitmap avec les bonnes dimensions
|
|
|
+ OutBmp.SetSize(CurrentFrameInfos.Width, CurrentFrameInfos.Height);
|
|
|
+
|
|
|
+ BufferPtr := nil;
|
|
|
+ Buffer := nil;
|
|
|
+ // 3) On alloue notre tampon pour les données compressées
|
|
|
+ If (BufferSize > 0) Then Reallocmem(Buffer, BufferSize);
|
|
|
+
|
|
|
+ // 4) On charge toutes les données dans notre tampon
|
|
|
+ // On se replace au début des données
|
|
|
+ Memory.Seek(OldPosition, soBeginning);
|
|
|
+ // On travail toujours sur une copie du "pointer"
|
|
|
+ BufferPtr := Buffer;
|
|
|
+ // On lit la taille du premier bloque
|
|
|
+ BlockSize := Memory.ReadByte;
|
|
|
+ While (BlockSize > 0) And Not (Memory.EOS) Do
|
|
|
+ Begin
|
|
|
+ // On charge les données dans le tampon. On previent des erreurs en cas de dépassements
|
|
|
+ BytesRead := Memory.Read(BufferPtr^, BlockSize);
|
|
|
+ Inc(BufferPtr, BytesRead);
|
|
|
+ If Not (Memory.EOS) Then BlockSize := Memory.ReadByte
|
|
|
+ Else
|
|
|
+ blocksize := 0;
|
|
|
+ End;
|
|
|
+ // On se replace au debut du tampon
|
|
|
+ BufferPtr := Buffer;
|
|
|
+ // 5) On decompresse les données
|
|
|
+ // On initialise notre buffer ou seront décompressées les données
|
|
|
+ TargetBufferSize := Int64(CurrentFrameInfos.Width) * Int64(CurrentFrameInfos.Height);
|
|
|
+ TargetBufferPtr := nil;
|
|
|
+ TargetBuffer := nil;
|
|
|
+ // Si la taille est plus grande que zero, on alloue l'espace nécessaire à notre tampon
|
|
|
+ If (TargetBufferSize > 0) Then Reallocmem(TargetBuffer, TargetBufferSize);
|
|
|
+
|
|
|
+ // Décodage des données compressées
|
|
|
+ Ret := DecodeLZW(Buffer, TargetBuffer, BufferSize, TargetBufferSize);
|
|
|
+
|
|
|
+ // 6) On transfert les données de l'image vers notre bitmap. Si il n'y a pas eu d'erreurs
|
|
|
+ If (Ret = dsOk) Then
|
|
|
+ Begin
|
|
|
+ TargetBufferPtr := TargetBuffer;
|
|
|
+ OutBmp.Clear(clrTransparent);
|
|
|
+
|
|
|
+ // Image non entrelacée
|
|
|
+ If Not (CurrentFrameInfos.Interlaced) Then
|
|
|
+ Begin
|
|
|
+ CurrentLine := 0;
|
|
|
+ While (CurrentLine <= CurrentFrameInfos.Height - 1) Do
|
|
|
+ Begin
|
|
|
+ LinePtr := OutBmp.GetScanLine(CurrentLine);// FFrames.Items[CurrentFrameIndex].Bitmap.GetScanLine(CurrentLine);
|
|
|
+ For x := 0 To (CurrentFrameInfos.Width - 1) Do
|
|
|
+ Begin
|
|
|
+ // Lecture de l'index de la couleur dans la palette
|
|
|
+ ColIdx := TargetBufferPtr^;
|
|
|
+ // On utilise la palette de couleur locale
|
|
|
+ If CurrentFrameInfos.HasLocalPalette Then
|
|
|
+ Begin
|
|
|
+ If LocalPalette <> nil Then // La palette est-elle chargée ?
|
|
|
+ Begin
|
|
|
+ //if (ColIdx> ColorCount-1) then ColIdx := ColorCount -1;
|
|
|
+ If (ColIdx < ColorCount) Then TargetColor := LocalPalette.Colors[ColIdx].Value
|
|
|
+ Else
|
|
|
+ TargetColor := clrTransparent;
|
|
|
+ End
|
|
|
+ Else If FGlobalPalette <> nil Then // Non, alors on utilise la palette globale si elle est présente
|
|
|
+ Begin
|
|
|
+ //if (ColIdx> PaletteCount-1) then ColIdx := PaletteCount -1;
|
|
|
+ If (ColIdx < PaletteCount) Then TargetColor := FGlobalPalette.Colors[ColIdx].Value
|
|
|
+ Else
|
|
|
+ TargetColor := clrTransparent;
|
|
|
+ End
|
|
|
+ Else
|
|
|
+ Begin
|
|
|
+ AddError(rsEmptyColorMap);
|
|
|
+ Exit;
|
|
|
+ End;
|
|
|
+ End
|
|
|
+ Else // On utilise la palette de couleur globale
|
|
|
+ Begin
|
|
|
+ If FGlobalPalette <> nil Then
|
|
|
+ Begin
|
|
|
+ //if (ColIdx> PaletteCount-1) then ColIdx := PaletteCount -1;
|
|
|
+ If (ColIdx < PaletteCount) Then TargetColor := FGlobalPalette.Colors[ColIdx].Value
|
|
|
+ Else
|
|
|
+ TargetColor := clrTransparent;
|
|
|
+ End
|
|
|
+ Else If LocalPalette <> nil Then
|
|
|
+ Begin
|
|
|
+ //if (ColIdx> ColorCount-1) then ColIdx := ColorCount -1;
|
|
|
+ If (ColIdx > ColorCount - 1) Then //ColIdx := ColorCount -1;
|
|
|
+ TargetColor := LocalPalette.Colors[ColIdx].Value
|
|
|
+ Else
|
|
|
+ TargetColor := clrTransparent;
|
|
|
+ End
|
|
|
+ Else
|
|
|
+ Begin
|
|
|
+ AddError(rsEmptyColorMap);
|
|
|
+ Exit;
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+
|
|
|
+ If CurrentFrameInfos.IsTransparent Then
|
|
|
+ Begin
|
|
|
+ If FHasGlobalPalette Then If ColIdx < FGlobalPalette.Count Then OutBmp.TransparentColor := FGlobalPalette.Colors[ColIdx].Value.ToColor
|
|
|
+ Else If ColIdx < LocalPalette.Count Then OutBmp.TransparentColor := LocalPalette.Colors[ColIdx].Value.ToColor;
|
|
|
+
|
|
|
+ If (Self.FTransparent) Then
|
|
|
+ Begin
|
|
|
+ If (ColIdx = CurrentFrameInfos.TransparentColorIndex) Then
|
|
|
+ begin
|
|
|
+ TargetColor.Alpha := 0; // clrTransparent;
|
|
|
+ end;
|
|
|
+ If (CurrentFrameInfos.TransparentColorIndex = CurrentFrameInfos.BackgroundColorIndex) Then FbackgroundColor.Alpha := 0; //clrTransparent;
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+ LinePtr^ := TargetColor;
|
|
|
+ // On avance de 1 élément dans nos "pointer"
|
|
|
+ Inc(TargetBufferPtr);
|
|
|
+ Inc(LinePtr);
|
|
|
+ End;
|
|
|
+ Inc(CurrentLine);
|
|
|
+ End;
|
|
|
+ End
|
|
|
+ Else // Image entrelacée
|
|
|
+ Begin
|
|
|
+ CurrentLine := 0;
|
|
|
+ For pass := 0 To 3 Do
|
|
|
+ Begin
|
|
|
+ Case Pass Of
|
|
|
+ 0:
|
|
|
+ Begin
|
|
|
+ CurrentLine := 0;
|
|
|
+ Increment := 8;
|
|
|
+ End;
|
|
|
+ 1:
|
|
|
+ Begin
|
|
|
+ CurrentLine := 4;
|
|
|
+ Increment := 8;
|
|
|
+ End;
|
|
|
+ 2:
|
|
|
+ Begin
|
|
|
+ CurrentLine := 2;
|
|
|
+ Increment := 4;
|
|
|
+ End;
|
|
|
+ Else
|
|
|
+ Begin
|
|
|
+ CurrentLine := 1;
|
|
|
+ Increment := 2;
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+ While (CurrentLine < CurrentFrameInfos.Height) Do
|
|
|
+ Begin
|
|
|
+ LinePtr :=OutBmp.GetScanLine(CurrentLine); // FFrames.Items[CurrentFrameIndex].Bitmap
|
|
|
+ For x := 0 To (FFrames.Items[CurrentFrameIndex].Bitmap.Width - 1) Do
|
|
|
+ Begin
|
|
|
+ // Lecture de l'index de la couleur dans la palette
|
|
|
+ ColIdx := TargetBufferPtr^;
|
|
|
+ // On utilise la palette de couleur locale
|
|
|
+ If CurrentFrameInfos.HasLocalPalette Then
|
|
|
+ Begin
|
|
|
+ If LocalPalette <> nil Then // La palette est-elle chargée ?
|
|
|
+ Begin
|
|
|
+ If (ColIdx < ColorCount) Then // Dans le cas contraire il s'agit d'un index pour la transparence
|
|
|
+ TargetColor := LocalPalette.Colors[ColIdx].Value;
|
|
|
+ End
|
|
|
+ Else If FGlobalPalette <> nil Then // Non, alors on utilise la palette globale si elle est présente
|
|
|
+ Begin
|
|
|
+ If (ColIdx < PaletteCount) Then //if (ColIdx< PaletteCount-1) then ColIdx := PaletteCount -1;
|
|
|
+ TargetColor := FGlobalPalette.Colors[ColIdx].Value;
|
|
|
+ End
|
|
|
+ Else
|
|
|
+ Begin
|
|
|
+ AddError(rsEmptyColorMap);
|
|
|
+ Exit;
|
|
|
+ End;
|
|
|
+ End
|
|
|
+ Else // On utilise la palette de couleur globale
|
|
|
+ Begin
|
|
|
+ If FGlobalPalette <> nil Then
|
|
|
+ Begin
|
|
|
+ If (ColIdx > PaletteCount - 1) Then ColIdx := PaletteCount - 1;
|
|
|
+ TargetColor := FGlobalPalette.Colors[ColIdx].Value;
|
|
|
+ End
|
|
|
+ Else If LocalPalette <> nil Then
|
|
|
+ Begin
|
|
|
+ If (ColIdx > ColorCount - 1) Then ColIdx := ColorCount - 1;
|
|
|
+ TargetColor := LocalPalette.Colors[ColIdx].Value;
|
|
|
+ End
|
|
|
+ Else
|
|
|
+ Begin
|
|
|
+ AddError(rsEmptyColorMap);
|
|
|
+ Exit;
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+
|
|
|
+ If CurrentFrameInfos.IsTransparent Then
|
|
|
+ Begin
|
|
|
+ If FHasGlobalPalette Then If ColIdx < FGlobalPalette.Count Then OutBmp.TransparentColor := FGlobalPalette.Colors[ColIdx].Value.ToColor
|
|
|
+ Else If ColIdx < LocalPalette.Count Then OutBmp.TransparentColor := LocalPalette.Colors[ColIdx].Value.ToColor;
|
|
|
+ If (FTransparent) Then
|
|
|
+ Begin
|
|
|
+ If CurrentFrameInfos.TransparentColorIndex = colIdx Then
|
|
|
+ begin
|
|
|
+ TargetColor.Alpha := 0; // := clrTransparent;
|
|
|
+ End;
|
|
|
+ If (CurrentFrameInfos.TransparentColorIndex = CurrentFrameInfos.BackgroundColorIndex) Then FBackgroundColor.Alpha := 0;
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+
|
|
|
+ LinePtr^ := TargetColor;
|
|
|
+ Inc(TargetBufferPtr);
|
|
|
+ If (CurrentLine < CurrentFrameInfos.Height - 1) Then Inc(LinePtr);
|
|
|
+ End;
|
|
|
+ Inc(CurrentLine, Increment);
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+ if DecoderStatus <> dsOk then
|
|
|
+ begin
|
|
|
+ //outBmp.Clear(ClrTransparent);
|
|
|
+ FFrames.Items[FCurrentLayerIndex].IsCorrupted := True;
|
|
|
+ FFrames.Items[FCurrentLayerIndex].Delay:= 1;
|
|
|
+ End;
|
|
|
+ Inc(FCurrentLayerIndex); // Index pour la prochaine image
|
|
|
+ End
|
|
|
+ Else
|
|
|
+ Begin
|
|
|
+ Case Ret Of
|
|
|
+ dsInvalidBufferSize: AddError(Format(rsInvalidBufferSize,[CurrentFrameIndex]));
|
|
|
+ dsInvalidInputBufferSize: AddError(Format(rsInvalidInputBufferSize,[CurrentFrameIndex]));
|
|
|
+ dsInvalidOutputBufferSize: AddError(Format(rsInvalidOutputBufferSize,[CurrentFrameIndex]));
|
|
|
+ dsBufferOverflow: AddError(Format(rsBufferOverFlow,[CurrentFrameIndex]));
|
|
|
+ dsOutputBufferTooSmall :
|
|
|
+ (* begin
|
|
|
+ // On supprime l'image. Le tampon de sortie étant trop petit, cela va générer des erreurs lors du transfert des données décompressées vers l'image
|
|
|
+ //FFrames.Delete(CurrentFrameIndex);
|
|
|
+
|
|
|
+ end;*)
|
|
|
+ dec(FCurrentLayerIndex);
|
|
|
+
|
|
|
+ End;
|
|
|
+ if Ret<>dsOutputBufferTooSmall then
|
|
|
+ begin
|
|
|
+ FFrames.Items[FCurrentLayerIndex].IsCorrupted := True;
|
|
|
+ FFrames.Items[FCurrentLayerIndex].Delay:= 1;
|
|
|
+ end;
|
|
|
+ End;
|
|
|
+
|
|
|
+ // On libére la mémoire allouée pour nos tampons
|
|
|
+ If (TargetBufferSize > 0) And (targetBuffer <> nil) Then FreeMem(TargetBuffer);
|
|
|
+ If (BufferSize > 0) And (Buffer <> nil) Then FreeMem(Buffer);
|
|
|
+ End;
|
|
|
+
|
|
|
+Begin
|
|
|
+ PaletteCount := 0;
|
|
|
+ ColorCount := 0;
|
|
|
+ LocalPalette := nil;
|
|
|
+ FFrames.Clear;
|
|
|
+
|
|
|
+ // Par defaut, on considère que la couleur de fond est totalement transparente
|
|
|
+ FBackgroundColor := clrTransparent;
|
|
|
+ // Si une palette globale existe, alors on charge
|
|
|
+ LoadGlobalPalette;
|
|
|
+ If FHasGlobalPalette Then
|
|
|
+ Begin
|
|
|
+ If FLogicalScreenChunk.BackgroundColorIndex < PaletteCount - 1 Then FBackgroundColor := FGlobalPalette.Colors[FLogicalScreenChunk.BackgroundColorIndex].Value
|
|
|
+ Else
|
|
|
+ Begin
|
|
|
+ FBackgroundColor := clrTransparent; //FGlobalPalette.Colors[FLogicalScreenChunk.BackgroundColorIndex].Value;
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+
|
|
|
+ // Les valeurs suivante seront renseignées lors du chargement d'une image
|
|
|
+ // On réinitialise juste les valeurs par défaut des informations de l'image en cours au cas ou il n'y aurait pas de GCE
|
|
|
+ With CurrentFrameInfos Do
|
|
|
+ Begin
|
|
|
+ Left := 0;
|
|
|
+ Top := 0;
|
|
|
+ Width := FLogicalScreenChunk.ScreenWidth;
|
|
|
+ Height := FLogicalScreenChunk.ScreenHeight;
|
|
|
+ Interlaced := False;
|
|
|
+ HasLocalPalette := False;
|
|
|
+ IsTransparent := False;
|
|
|
+ End;
|
|
|
+ // On ajoute l'image de départ afin de pouvoir assigner les valeurs des premières extensions (Extensions déclarées avant l'image)
|
|
|
+ CurrentLayer := FFrames.AddNewImage;
|
|
|
+ // On efface l'image avec la couleur de fond
|
|
|
+ //CurrentLayer.Bitmap.Clear(FBackgroundColor);
|
|
|
+ FCurrentLayerIndex := 0;
|
|
|
+ // On lit le 1er octet
|
|
|
+ Done := False;
|
|
|
+ While Not (Done) Do
|
|
|
+ Begin
|
|
|
+ // On verifie l'existence d'extensions avant les données de l'image (Application, Graphic Control, PlainText, Comment)
|
|
|
+ If Not (Memory.EOS) Then BlockID := Memory.ReadByte
|
|
|
+ Else
|
|
|
+ BlockID := GIF_Trailer;
|
|
|
+ If (BlockID = GIF_Trailer) Then
|
|
|
+ Begin
|
|
|
+ Done := True;
|
|
|
+ End;
|
|
|
+ If (BlockID = 0) Then
|
|
|
+ Begin
|
|
|
+ // On Saute les ID Nul
|
|
|
+ While (BlockId = 0) Do BlockId := Memory.ReadByte;
|
|
|
+ End
|
|
|
+ Else If (BlockID = GIF_IMAGEDESCRIPTOR) Then // C'est une image
|
|
|
+ Begin
|
|
|
+ // On charge l'image
|
|
|
+ LoadImage;
|
|
|
+ End
|
|
|
+ Else If (BlockID = GIF_EXTENSIONINTRODUCER) Then // c'est une extension
|
|
|
+ Begin
|
|
|
+ ReadExtension; // On charge toutes les extensions qui sont à la suite
|
|
|
+ End
|
|
|
+ Else
|
|
|
+ Begin
|
|
|
+ // Extension inconnue on saute jusqu'a trouver un ZERO.
|
|
|
+ // A Verifier avec le flag UseInput dans le "Graphic Control Extension"
|
|
|
+ // Ici on ignore simplement les données
|
|
|
+ While BlockID <> 0 Do
|
|
|
+ Begin
|
|
|
+ BlockID := Memory.ReadByte;
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+ // Si il y a des erreurs elles seront notifier à l'utilisateur
|
|
|
+ NotifyError;
|
|
|
+
|
|
|
+ // Il n'y a aucune images on notifie l'erreur
|
|
|
+ If FFrames.Count = 0 Then Raise Exception.Create(rsEmptyImage);
|
|
|
+
|
|
|
+ // On libere la mémoire, prise par nos palettes de couleurs si besoin
|
|
|
+ If (LocalPalette <> nil) Then
|
|
|
+ Begin
|
|
|
+ FreeAndNil(LocalPalette);
|
|
|
+ End;
|
|
|
+ If (FGlobalPalette <> nil) Then
|
|
|
+ Begin
|
|
|
+ FreeAndNil(FGlobalPalette);
|
|
|
+ End;
|
|
|
+End;
|
|
|
+
|
|
|
+{%endregion%}
|
|
|
+
|
|
|
+{%region=====[ TGIFRenderCacheListItem ]========================================}
|
|
|
+
|
|
|
+Constructor TGIFRenderCacheListItem.Create;
|
|
|
+Begin
|
|
|
+ Inherited Create;
|
|
|
+ FBitmap := Graphics.TBitmap.Create;
|
|
|
+ FDelay := 0;
|
|
|
+End;
|
|
|
+
|
|
|
+Destructor TGIFRenderCacheListItem.Destroy;
|
|
|
+Begin
|
|
|
+ FreeAndNil(FBitmap);
|
|
|
+ Inherited Destroy;
|
|
|
+End;
|
|
|
+
|
|
|
+{%endregion%}
|
|
|
+
|
|
|
+{%region=====[ TGIFRenderCacheList ]============================================}
|
|
|
+
|
|
|
+Function TGIFRenderCacheList.GetItems(Index : Integer): TGIFRenderCacheListItem;
|
|
|
+Begin
|
|
|
+ Result := TGIFRenderCacheListItem(Inherited Items[Index]);
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFRenderCacheList.SetItems(Index : Integer; AGIFRenderCache : TGIFRenderCacheListItem);
|
|
|
+Begin
|
|
|
+ Put(Index, AGIFRenderCache);
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFRenderCacheList.Clear;
|
|
|
+Var
|
|
|
+ anItem: TGIFRenderCacheListItem;
|
|
|
+ i: Integer;
|
|
|
+Begin
|
|
|
+ If Count > 0 Then
|
|
|
+ Begin
|
|
|
+ For i := Count - 1 Downto 0 do
|
|
|
+ Begin
|
|
|
+ AnItem := Items[i];
|
|
|
+ If anItem <> nil Then anItem.Free;
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+ Inherited Clear;
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFRenderCacheList.AddNewCache: TGIFRenderCacheListItem;
|
|
|
+Var
|
|
|
+ anItem: TGIFRenderCacheListItem;
|
|
|
+Begin
|
|
|
+ anitem := TGIFRenderCacheListItem.Create;
|
|
|
+ Add(anItem);
|
|
|
+ Result := Items[Self.Count - 1];
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFRenderCacheList.Add(AGIFRenderCache : TGIFRenderCacheListItem): Integer;
|
|
|
+Begin
|
|
|
+ Result := Inherited Add(AGIFRenderCache);
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFRenderCacheList.Extract(Item : TGIFRenderCacheListItem): TGIFRenderCacheListItem;
|
|
|
+Begin
|
|
|
+ Result := TGIFRenderCacheListItem(Inherited Extract(Item));
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFRenderCacheList.Remove(AGIFRenderCache : TGIFRenderCacheListItem): Integer;
|
|
|
+Begin
|
|
|
+ Result := Inherited Remove(AGIFRenderCache);
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFRenderCacheList.IndexOf(AGIFRenderCache : TGIFRenderCacheListItem): Integer;
|
|
|
+Begin
|
|
|
+ Result := Inherited IndexOf(AGIFRenderCache);
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFRenderCacheList.First: TGIFRenderCacheListItem;
|
|
|
+Begin
|
|
|
+ Result := TGIFRenderCacheListItem(Inherited First);
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFRenderCacheList.Last: TGIFRenderCacheListItem;
|
|
|
+Begin
|
|
|
+ Result := TGIFRenderCacheListItem(Inherited Last);
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFRenderCacheList.Insert(Index : Integer; AGIFRenderCache : TGIFRenderCacheListItem);
|
|
|
+Begin
|
|
|
+ Inherited Insert(Index, AGIFRenderCache);
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFRenderCacheList.IsIndexOk(anIndex: Integer): Boolean;
|
|
|
+Begin
|
|
|
+ Result := True;
|
|
|
+ If (anIndex < 0) or (anIndex > Count-1) then result := False;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFRenderCacheList.Pack;
|
|
|
+Var
|
|
|
+ i: Integer;
|
|
|
+Begin
|
|
|
+ if Count>1 then
|
|
|
+ begin
|
|
|
+ I := 0;
|
|
|
+ While I<Count do
|
|
|
+ begin
|
|
|
+ if Items[I].IsCorrupted then
|
|
|
+ begin
|
|
|
+ Remove(Items[I]);
|
|
|
+ break;
|
|
|
+ End;
|
|
|
+ inc(I);
|
|
|
+ End;
|
|
|
+ if I<Count then Pack;
|
|
|
+ End;
|
|
|
+End;
|
|
|
+
|
|
|
+{%endregion%}
|
|
|
+
|
|
|
+{%region=====[ TGIFViewer ]=====================================================}
|
|
|
+
|
|
|
+Constructor TGIFViewer.Create(AOwner: TComponent);
|
|
|
+Begin
|
|
|
+ Inherited Create(AOwner);
|
|
|
+ ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks];
|
|
|
+ AutoSize := False;
|
|
|
+ FCenter := False;
|
|
|
+ FStretch := False;
|
|
|
+ FTransparent := True;
|
|
|
+ With GetControlClassDefaultSize Do SetInitialBounds(0, 0, CX, CY);
|
|
|
+ FRestoreBitmap := nil;
|
|
|
+ FRenderCache := TGIFRenderCacheList.Create(False);
|
|
|
+ FGIFLoader := TGIFImageLoader.Create;
|
|
|
+ FGIFLoader.OnLoadError := @DoInternalOnLoadError;
|
|
|
+ FVirtualView := TFastBitmap.Create;
|
|
|
+ FCurrentView := nil;
|
|
|
+ FCurrentView := Graphics.TBitmap.Create;
|
|
|
+ FRestoreBitmap := nil;
|
|
|
+ FAutoPlay := False;
|
|
|
+ FBorderShow := False;
|
|
|
+ FBorderColor := clBlack;
|
|
|
+ FBorderWidth := 1;
|
|
|
+ FBevelInner := bvNone;
|
|
|
+ FBevelOuter := bvNone;
|
|
|
+ FBevelWidth := 1;
|
|
|
+ FColor := clNone;
|
|
|
+ FDisplayInvalidFrames := False;
|
|
|
+ FAutoRemoveInvalidFrame := True;
|
|
|
+ FLastDrawMode := dmNone;
|
|
|
+
|
|
|
+ FAnimateTimer := TTimer.Create(nil);
|
|
|
+ With FAnimateTimer Do
|
|
|
+ Begin
|
|
|
+ Enabled := False;
|
|
|
+ Interval := 1000;
|
|
|
+ OnTimer := @DoTimerAnimate;
|
|
|
+ End;
|
|
|
+ FAnimateSpeed := 1;
|
|
|
+ FCurrentFrameIndex := 0;
|
|
|
+ FGIFWidth := 90;
|
|
|
+ FGIFHeight := 90;
|
|
|
+ FAutoStretchMode := smManual;
|
|
|
+End;
|
|
|
+
|
|
|
+Destructor TGIFViewer.Destroy;
|
|
|
+Begin
|
|
|
+ FAnimateTimer.Enabled := False;
|
|
|
+
|
|
|
+ FreeAndNil(FAnimateTimer);
|
|
|
+ If FCurrentView <> nil Then FreeAndNil(FCurrentView);
|
|
|
+ If FRestoreBitmap <> nil Then FreeAndNil(FRestoreBitmap);
|
|
|
+ FreeAndNil(FVirtualView);
|
|
|
+ FRenderCache.Clear;
|
|
|
+ FreeAndNil(FRenderCache);
|
|
|
+ FreeAndNil(FGIFLoader);
|
|
|
+
|
|
|
+ Inherited Destroy;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.SetCenter(Const Value: Boolean);
|
|
|
+Begin
|
|
|
+ If Value = FCenter Then exit;
|
|
|
+ FCenter := Value;
|
|
|
+ Invalidate;
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFViewer.GetCanvas: TCanvas;
|
|
|
+Begin
|
|
|
+ Result := Inherited Canvas;// FCurrentView.Canvas
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFViewer.GetFrameCount: Integer;
|
|
|
+Begin
|
|
|
+ If FCache Then
|
|
|
+ Result := FRenderCache.Count
|
|
|
+ Else Begin
|
|
|
+ Result := FGifLoader.FrameCount;
|
|
|
+ End;
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFViewer.GetGIFVersion: String;
|
|
|
+Begin
|
|
|
+ Result := FGIFLoader.Version;
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFViewer.GetRawFrameItem(Index : Integer): TGIFImageListItem;
|
|
|
+Begin
|
|
|
+ Result := nil;
|
|
|
+ If (Index >= 0) And (Index < FGIFLoader.FrameCount) Then Result := FGIFLoader.Frames[Index];
|
|
|
+end;
|
|
|
+
|
|
|
+Procedure TGIFViewer.SetAutoStretchMode(AValue: TGIFAutoStretchMode);
|
|
|
+Begin
|
|
|
+ If FAutoStretchMode = AValue Then Exit;
|
|
|
+ FAutoStretchMode := AValue;
|
|
|
+ Invalidate;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.SetStretch(Const Value: Boolean);
|
|
|
+Begin
|
|
|
+ If Value = FStretch Then exit;
|
|
|
+ FStretch := Value;
|
|
|
+ Invalidate;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.SetPause(Const Value: Boolean);
|
|
|
+Begin
|
|
|
+ If Value = FPause Then exit;
|
|
|
+ FPause := Value;
|
|
|
+ If FPause Then FAnimateTimer.Enabled := False;
|
|
|
+ If Assigned(FOnPause) Then FOnPause(Self);
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.SetFileName(Const Value: String);
|
|
|
+Begin
|
|
|
+ If Value = FFileName Then exit;
|
|
|
+ FFileName := Value;
|
|
|
+ LoadFromFile(FFileName);
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFViewer.GetFrame(Const Index: Integer): Graphics.TBitmap;
|
|
|
+Begin
|
|
|
+ Result := nil;
|
|
|
+ If (Index >= 0) And (Index < FrameCount) Then Result := FRenderCache.Items[Index].Bitmap;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.SetTransparent(Const Value: Boolean);
|
|
|
+Begin
|
|
|
+ If FTransparent = Value Then exit;
|
|
|
+ FTransparent := Value;
|
|
|
+ FGIFLoader.Transparent := Value;
|
|
|
+ If FFileName <> '' Then LoadFromFile(FFileName);
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.SetBevelWidth(Const Value: TBevelWidth);
|
|
|
+Begin
|
|
|
+ If FBevelWidth <> Value Then
|
|
|
+ Begin
|
|
|
+ FBevelWidth := Value;
|
|
|
+ Invalidate;
|
|
|
+ End;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.ResetCurrentView;
|
|
|
+Var
|
|
|
+ I: Integer;
|
|
|
+ Corrupted : Boolean;
|
|
|
+begin
|
|
|
+ if FRenderCache.Count>1 then
|
|
|
+ begin
|
|
|
+ if not(FDisplayInvalidFrames) then
|
|
|
+ begin
|
|
|
+ Corrupted := false;
|
|
|
+ i := 0;
|
|
|
+ Repeat
|
|
|
+ Corrupted := FRenderCache.Items[i].IsCorrupted;
|
|
|
+ inc(i);
|
|
|
+ until (i>FRenderCache.Count-1) or (Corrupted = false);
|
|
|
+ if (i>FRenderCache.Count-1) and (Corrupted = true) then
|
|
|
+ begin
|
|
|
+ Raise Exception.Create(rsAllFrameCorrupted);
|
|
|
+ exit;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ Dec(i);
|
|
|
+ FCurrentframeIndex := i;
|
|
|
+ FAnimateTimer.Interval := FRenderCache.Items[i].Delay;
|
|
|
+ FCurrentView.Assign(FRenderCache.Items[i].Bitmap);
|
|
|
+ end;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ FAnimateTimer.Interval := FRenderCache.Items[0].Delay;
|
|
|
+ FCurrentView.Assign(FRenderCache.Items[0].Bitmap);
|
|
|
+ end;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ FCurrentView.Assign(FRenderCache.Items[0].Bitmap);
|
|
|
+ end;
|
|
|
+ FLastDrawMode := dmNone;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.SetBevelInner(Const Value: TPanelBevel);
|
|
|
+Begin
|
|
|
+ If BevelInner <> Value Then
|
|
|
+ Begin
|
|
|
+ FBevelInner := Value;
|
|
|
+ Invalidate;
|
|
|
+ End;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.SetBevelOuter(Const Value: TPanelBevel);
|
|
|
+Begin
|
|
|
+ If BevelOuter <> Value Then
|
|
|
+ Begin
|
|
|
+ FBevelOuter := Value;
|
|
|
+ Invalidate;
|
|
|
+ End;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.DoInternalOnLoadError(Sender: TObject; Const ErrorCount: Integer; Const ErrorList: TStringList);
|
|
|
+Begin
|
|
|
+ If Assigned(FOnLoadError) Then FOnloadError(Self, ErrorCount, ErrorList);
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.DoTimerAnimate(Sender: TObject);
|
|
|
+Begin
|
|
|
+ Inc(FCurrentFrameIndex);
|
|
|
+ If FCurrentFrameIndex > (FGIFLoader.FrameCount - 1) Then FCurrentFrameIndex := 0;
|
|
|
+
|
|
|
+ If (not FCache) and (FCurrentFrameIndex >= FRenderCache.Count) Then
|
|
|
+ Begin
|
|
|
+ RenderFrame(FCurrentFrameIndex);
|
|
|
+ End;
|
|
|
+
|
|
|
+ If Assigned(FOnFrameChange) Then FOnFrameChange(Self);
|
|
|
+ if not(FDisplayInvalidFrames) then
|
|
|
+ begin
|
|
|
+ if not(FRenderCache.Items[FCurrentFrameIndex].IsCorrupted) then
|
|
|
+ begin
|
|
|
+ FAnimateTimer.Interval := FRenderCache.Items[FCurrentFrameIndex].Delay;
|
|
|
+ FCurrentView.Assign(FRenderCache.Items[FCurrentFrameIndex].Bitmap);
|
|
|
+ End
|
|
|
+ else FAnimateTimer.Interval := FRenderCache.Items[FCurrentFrameIndex].Delay;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ FAnimateTimer.Interval := FRenderCache.Items[FCurrentFrameIndex].Delay;
|
|
|
+ FCurrentView.Assign(FRenderCache.Items[FCurrentFrameIndex].Bitmap);
|
|
|
+ end;
|
|
|
+ Invalidate;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.RenderFrame(Index: Integer);
|
|
|
+Var
|
|
|
+ Src: TFastBitmap;
|
|
|
+ pTop, pLeft: Integer;
|
|
|
+ iDrawMode: TFastBitmapDrawMode;
|
|
|
+ TmpBmp : Graphics.TBitmap;
|
|
|
+Begin
|
|
|
+
|
|
|
+ Src := FGIFLoader.Frames.Items[Index].Bitmap;
|
|
|
+ pLeft := FGIFLoader.Frames.Items[Index].Left;
|
|
|
+ pTop := FGIFLoader.Frames.Items[Index].Top;
|
|
|
+
|
|
|
+ FRenderCache.AddNewCache;
|
|
|
+ FRenderCache.Items[Index].Delay := FGIFLoader.Frames[Index].Delay * FAnimateSpeed;
|
|
|
+ FRenderCache.Items[Index].IsCorrupted := FGIFLoader.Frames[Index].IsCorrupted;
|
|
|
+
|
|
|
+ If (FTransparent) Then
|
|
|
+ Begin
|
|
|
+ iDrawMode := dmAlphaCheck;
|
|
|
+ End
|
|
|
+ Else
|
|
|
+ Begin
|
|
|
+ iDrawMode := dmSet;
|
|
|
+ End;
|
|
|
+
|
|
|
+ If Index = 0 Then
|
|
|
+ Begin
|
|
|
+ If (FTransparent) Then
|
|
|
+ Begin
|
|
|
+ FVirtualView.Clear(clrTransparent);
|
|
|
+ End
|
|
|
+ Else
|
|
|
+ Begin
|
|
|
+ FVirtualView.Clear(FGIFLoader.BackgroundColor);
|
|
|
+ End;
|
|
|
+ FVirtualView.PutImage(Src, 0, 0, Src.Width, Src.Height, pLeft, pTop, dmSet);
|
|
|
+ if FGIFLoader.Frames.Items[0].DrawMode = dmKeep then begin
|
|
|
+ if Assigned( FRestoreBitmap) then begin
|
|
|
+ FRestoreBitmap.Free;
|
|
|
+ end;
|
|
|
+ FRestoreBitmap := FVirtualView.Clone;
|
|
|
+ end;
|
|
|
+ End
|
|
|
+ Else
|
|
|
+ Begin
|
|
|
+
|
|
|
+ With FGIFLoader.Frames.Items[Index] Do
|
|
|
+ Begin
|
|
|
+ Case DrawMode Of
|
|
|
+ dmNone:
|
|
|
+ Begin
|
|
|
+ FVirtualView.PutImage(Src, 0, 0, Src.Width, Src.Height, pLeft, pTop, iDrawMode);
|
|
|
+ End;
|
|
|
+ dmKeep:
|
|
|
+ Begin
|
|
|
+ if FLastDrawMode = dmErase then
|
|
|
+ begin
|
|
|
+ If (FGIFLoader.Frames.Items[Index].IsTransparent And FTransparent) Then FVirtualView.Clear(clrTransparent)
|
|
|
+ Else
|
|
|
+ FVirtualView.Clear(FGIFLoader.BackgroundColor);
|
|
|
+ end;
|
|
|
+ FVirtualView.PutImage(Src, 0, 0, Src.Width, Src.Height, pLeft, pTop, iDrawMode);
|
|
|
+ If Assigned(FRestoreBitmap) Then FreeAndNil(FRestoreBitmap);
|
|
|
+ FRestoreBitmap := FVirtualView.Clone;
|
|
|
+ End;
|
|
|
+ dmErase:
|
|
|
+ Begin
|
|
|
+ If (FGIFLoader.Frames.Items[Index].IsTransparent And FTransparent) Then FVirtualView.Clear(clrTransparent)
|
|
|
+ Else
|
|
|
+ FVirtualView.Clear(FGIFLoader.BackgroundColor);
|
|
|
+ FVirtualView.PutImage(Src, 0, 0, Src.Width, Src.Height, pLeft, pTop, iDrawMode);
|
|
|
+ End;
|
|
|
+ dmRestore:
|
|
|
+ Begin
|
|
|
+ if FLastDrawMode = dmErase then
|
|
|
+ begin
|
|
|
+ If (FGIFLoader.Frames.Items[Index].IsTransparent And FTransparent) Then FVirtualView.Clear(clrTransparent)
|
|
|
+ Else
|
|
|
+ FVirtualView.Clear(FGIFLoader.BackgroundColor);
|
|
|
+ End;
|
|
|
+
|
|
|
+ If Assigned(FRestoreBitmap) Then FVirtualView.PutImage(FRestoreBitmap, 0, 0, FRestoreBitmap.Width, FRestoreBitmap.Height, 0, 0, dmSet)
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ If (FGIFLoader.Frames.Items[Index].IsTransparent And FTransparent) Then FVirtualView.Clear(clrTransparent)
|
|
|
+ Else
|
|
|
+ FVirtualView.Clear(FGIFLoader.BackgroundColor);
|
|
|
+ end;
|
|
|
+
|
|
|
+ FVirtualView.PutImage(Src, 0, 0, Src.Width, Src.Height, pLeft, pTop, iDrawMode);
|
|
|
+ End;
|
|
|
+ Else
|
|
|
+ FVirtualView.PutImage(Src, 0, 0, Src.Width, Src.Height, pLeft, pTop, dmSet);
|
|
|
+ End;
|
|
|
+ FLastDrawMode := DrawMode;
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+ // Note : Sous MacOS on ne peux pas assigner FRenderCache.Items[Index].Bitmap directement avec
|
|
|
+ // FVirtualView.GetBitmap; On est obligé de créer le bitmap de destination et utiliser Assign.
|
|
|
+ // Dans le cas contraire seulment la première image sera affichée.
|
|
|
+ //TmpBmp := Graphics.TBitmap.Create; <== MEMORY LEAK
|
|
|
+ TmpBmp := FVirtualView.GetBitmap;
|
|
|
+ FRenderCache.Items[Index].Bitmap.Assign(TmpBmp);
|
|
|
+ FreeAndNil(TmpBmp);
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.ComputeCache;
|
|
|
+Var
|
|
|
+ I: Integer;
|
|
|
+Begin
|
|
|
+ FCurrentFrameIndex := 0;
|
|
|
+ FRenderCache.Clear;
|
|
|
+ If FGIFLoader.FrameCount > 0 Then
|
|
|
+ Begin
|
|
|
+ For I := 0 To Pred(FGIFLoader.FrameCount) Do
|
|
|
+ Begin
|
|
|
+ RenderFrame(I);
|
|
|
+ End;
|
|
|
+ end;
|
|
|
+ if AutoRemoveInvalidFrame then FRenderCache.Pack;
|
|
|
+ ResetCurrentView;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.CalculatePreferredSize(Var PreferredWidth, PreferredHeight: Integer; WithThemeSpace: Boolean);
|
|
|
+Var
|
|
|
+ extraWidth: Integer;
|
|
|
+Begin
|
|
|
+ extraWidth := - 2;
|
|
|
+ if FBorderShow then extraWidth := (FBorderWidth * 2) + (FBevelWidth * 2);
|
|
|
+ PreferredWidth := FGIFWidth + extraWidth + 2;
|
|
|
+ PreferredHeight := FGIFHeight + extraWidth + 2;
|
|
|
+End;
|
|
|
+
|
|
|
+Class Function TGIFViewer.GetControlClassDefaultSize: TSize;
|
|
|
+Begin
|
|
|
+ Result.CX := 90; // = ClientWidth
|
|
|
+ Result.CY := 90; // = ClientHeight
|
|
|
+End;
|
|
|
+
|
|
|
+Function TGIFViewer.DestRect: TRect;
|
|
|
+Var
|
|
|
+ PicWidth, PicHeight: Integer;
|
|
|
+ ImgWidth, ImgHeight: Integer;
|
|
|
+ n: Integer;
|
|
|
+
|
|
|
+ procedure KeepAspectRatio( Var aWidth, aHeight : Integer; MaxWidth, MaxHeight : Integer);
|
|
|
+ var
|
|
|
+ w, h : Integer;
|
|
|
+ begin
|
|
|
+ w := MaxWidth;
|
|
|
+ h := (aHeight * w) Div aWidth;
|
|
|
+ If h > MaxHeight Then
|
|
|
+ Begin
|
|
|
+ h := MaxHeight;
|
|
|
+ w := (aWidth * h) Div aHeight;
|
|
|
+ End;
|
|
|
+ aWidth := w;
|
|
|
+ aHeight := h;
|
|
|
+ End;
|
|
|
+
|
|
|
+Begin
|
|
|
+ PicWidth := FCurrentView.Width;
|
|
|
+ PicHeight := FCurrentView.Height;
|
|
|
+ ImgWidth := ClientWidth;
|
|
|
+ ImgHeight := ClientHeight;
|
|
|
+ If (PicWidth = 0) Or (PicHeight = 0) Then Exit(Rect(0, 0, 0, 0));
|
|
|
+
|
|
|
+ if FAutoStretchMode <> smManual then
|
|
|
+ begin
|
|
|
+ Case FAutoStretchMode of
|
|
|
+ smStretchAll : FStretch := True;
|
|
|
+ smStretchOnlyBigger : if (PicWidth > ImgWidth) or (PicHeight > ImgHeight) then FStretch := True else FStretch := False;
|
|
|
+ smStretchOnlySmaller : if (PicWidth < ImgWidth) and (PicHeight < ImgHeight) then FStretch := True else FStretch := False;
|
|
|
+ end;
|
|
|
+ if Assigned(FOnStretchChanged) then FOnStretchChanged(Self,FStretch);
|
|
|
+ End;
|
|
|
+
|
|
|
+ If FStretch Then
|
|
|
+ Begin
|
|
|
+ KeepAspectRatio(PicWidth, PicHeight,ImgWidth, ImgHeight);
|
|
|
+ End;
|
|
|
+
|
|
|
+ n := FBorderWidth + FBevelWidth;
|
|
|
+ If FBorderShow Then
|
|
|
+ Begin
|
|
|
+ Result := Rect(n, n, n + PicWidth, n + PicHeight);
|
|
|
+ End
|
|
|
+ Else
|
|
|
+ Result := Rect(0, 0, PicWidth, PicHeight);
|
|
|
+
|
|
|
+ If FCenter Then
|
|
|
+ Begin
|
|
|
+ If FBorderShow Then
|
|
|
+ Begin
|
|
|
+ Result.Left := n + ((ClientWidth -(n+n)) - PicWidth) shr 1;
|
|
|
+ Result.Top := n + ((ClientHeight-(n+n)) - PicHeight) shr 1;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ Result.Left := ((ClientWidth - PicWidth) shr 1);
|
|
|
+ Result.Top := ((ClientHeight - PicHeight) shr 1);
|
|
|
+ end;
|
|
|
+ Result.Right := Result.Left + PicWidth;
|
|
|
+ Result.Bottom := Result.Top + PicHeight;
|
|
|
+ End;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.Paint;
|
|
|
+
|
|
|
+ Procedure DrawFrame;
|
|
|
+ Begin
|
|
|
+ With Inherited Canvas Do
|
|
|
+ Begin
|
|
|
+ Pen.Color := clBlack;
|
|
|
+ Pen.Style := psDash;
|
|
|
+ MoveTo(0, 0);
|
|
|
+ LineTo(Self.Width - 1, 0);
|
|
|
+ LineTo(Self.Width - 1, Self.Height - 1);
|
|
|
+ LineTo(0, Self.Height - 1);
|
|
|
+ LineTo(0, 0);
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+
|
|
|
+Var
|
|
|
+ R: TRect;
|
|
|
+ C: TCanvas;
|
|
|
+ ARect: TRect;
|
|
|
+ w: Integer;
|
|
|
+Begin
|
|
|
+
|
|
|
+ If csDesigning In ComponentState Then DrawFrame;
|
|
|
+
|
|
|
+ C := Inherited Canvas;
|
|
|
+ FPainting := True;
|
|
|
+ R := DestRect;
|
|
|
+ Try
|
|
|
+ C.Lock;
|
|
|
+ // Fond
|
|
|
+ If (FColor <> clNone) Then //and Not(FTransparent)
|
|
|
+ Begin
|
|
|
+ With C Do
|
|
|
+ Begin
|
|
|
+ Brush.Style := bsSolid;
|
|
|
+ Brush.Color := FColor;
|
|
|
+ FillRect(0, 0, ClientWidth, ClientHeight);
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+
|
|
|
+ // Bitmap
|
|
|
+ FCurrentView.Transparent := FTransparent;
|
|
|
+ C.StretchDraw(R, FCurrentView);
|
|
|
+
|
|
|
+ // Bordures
|
|
|
+ If FBorderShow Then
|
|
|
+ Begin
|
|
|
+ ARect := rect(0, 0, ClientWidth, ClientHeight);
|
|
|
+ w := FBevelWidth;
|
|
|
+ If (FBevelInner <> bvNone) And (w > 0) Then C.Frame3d(ARect, w, BevelInner); // Note: Frame3D inflates ARect
|
|
|
+ InflateRect(ARect, -(FBorderWidth + 1), -(FBorderWidth + 1));
|
|
|
+ If (FBevelOuter <> bvNone) And (w > 0) Then C.Frame3d(ARect, w, BevelOuter);
|
|
|
+
|
|
|
+ If FBorderWidth > 0 Then With C Do
|
|
|
+ Begin
|
|
|
+ Pen.Style := psSolid;
|
|
|
+ Pen.Width := FBorderWidth;
|
|
|
+ Pen.Color := FBorderColor;
|
|
|
+ Brush.Style := bsClear;
|
|
|
+ Rectangle(0, 0, ClientWidth, ClientHeight);
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+
|
|
|
+ C.UnLock;
|
|
|
+ Finally
|
|
|
+ FPainting := False;
|
|
|
+ End;
|
|
|
+
|
|
|
+ Inherited Paint;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.Loaded;
|
|
|
+begin
|
|
|
+ if FFileName<>'' then LoadFromFile(FFileName);
|
|
|
+ inherited Loaded;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGIFViewer.BeforeLoad;
|
|
|
+begin
|
|
|
+ FAnimateTimer.Enabled := False;
|
|
|
+ FPause := False;
|
|
|
+ FAnimated := False;
|
|
|
+ FCurrentFrameIndex := 0;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGIFViewer.AfterLoad;
|
|
|
+begin
|
|
|
+ FGIFWidth := FGIFLoader.Width;
|
|
|
+ FGIFHeight := FGIFLoader.Height;
|
|
|
+ FVirtualView.SetSize(FGIFWidth, FGIFHeight);
|
|
|
+
|
|
|
+ if FCache then
|
|
|
+ ComputeCache
|
|
|
+ else begin
|
|
|
+ FRenderCache.Clear;
|
|
|
+ FCurrentFrameIndex := 0;
|
|
|
+ RenderFrame(0);
|
|
|
+ ResetCurrentView;
|
|
|
+ end;
|
|
|
+
|
|
|
+ If AutoSize Then
|
|
|
+ Begin
|
|
|
+ InvalidatePreferredSize;
|
|
|
+ AdjustSize;
|
|
|
+ End;
|
|
|
+ Invalidate;
|
|
|
+ If FAutoPlay Then Start;
|
|
|
+end;
|
|
|
+
|
|
|
+Procedure TGIFViewer.Invalidate;
|
|
|
+Begin
|
|
|
+ If FPainting Then exit;
|
|
|
+ Inherited Invalidate;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.LoadFromStream(aStream : TStream);
|
|
|
+Begin
|
|
|
+ BeforeLoad;
|
|
|
+ FGIFLoader.FErrorList.Clear;
|
|
|
+ FGIFLoader.FErrorCOunt := 0;
|
|
|
+ FGIFLoader.LoadFromStream(aStream);
|
|
|
+ AfterLoad;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.LoadFromFile(Const aFileName: String);
|
|
|
+Begin
|
|
|
+ BeforeLoad;
|
|
|
+ if Not(FileExists(aFileName)) then
|
|
|
+ begin
|
|
|
+ MessageDlg(Format(rsFileNotFound,[aFileName]), mtError, [mbOK],0);
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ FGIFLoader.LoadFromFile(aFileName);
|
|
|
+ FFileName := aFileName;
|
|
|
+ AfterLoad;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.LoadFromResource(Const ResName: String);
|
|
|
+Var
|
|
|
+ Resource: TLResource;
|
|
|
+Begin
|
|
|
+ BeforeLoad;
|
|
|
+ Resource := LazarusResources.Find(ResName);
|
|
|
+ If Resource = nil Then Raise Exception.Create(Format(rsResourceNotFound,[ResName]))
|
|
|
+ Else If CompareText(LazarusResources.Find(ResName).ValueType, 'gif') = 0 Then
|
|
|
+ Begin
|
|
|
+ FGIFLoader.LoadFromResource(ResName);
|
|
|
+ AfterLoad;
|
|
|
+ End;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.Start;
|
|
|
+Begin
|
|
|
+ If Not (FPause) Then FCurrentFrameIndex := 0;
|
|
|
+ FPause := False;
|
|
|
+ FAnimated := True;
|
|
|
+ FAnimateTimer.Enabled := True;
|
|
|
+ If Assigned(FOnStart) Then FOnStart(Self);
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.Stop;
|
|
|
+Begin
|
|
|
+ FAnimateTimer.Enabled := False;
|
|
|
+ FAnimated := False;
|
|
|
+ FPause := False;
|
|
|
+ If Assigned(FOnStop) Then FOnStop(Self);
|
|
|
+ FCurrentframeIndex := 0;
|
|
|
+ ResetCurrentView;
|
|
|
+ Invalidate;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.Pause;
|
|
|
+Begin
|
|
|
+ FAnimateTimer.Enabled := False;
|
|
|
+ FPause := True;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.NextFrame;
|
|
|
+begin
|
|
|
+ if FCurrentFrameIndex < FGifLoader.FrameCount - 1 then
|
|
|
+ begin
|
|
|
+ Inc(FCurrentFrameIndex);
|
|
|
+
|
|
|
+ repeat
|
|
|
+
|
|
|
+ If (not FCache) and (FCurrentFrameIndex >= FRenderCache.Count) Then
|
|
|
+ begin
|
|
|
+ RenderFrame(FCurrentFrameIndex);
|
|
|
+ end;
|
|
|
+
|
|
|
+ If Assigned(FOnFrameChange) Then FOnFrameChange(Self);
|
|
|
+
|
|
|
+ if not(FDisplayInvalidFrames) then
|
|
|
+ begin
|
|
|
+ if not(FRenderCache.Items[FCurrentFrameIndex].IsCorrupted) then
|
|
|
+ begin
|
|
|
+ FCurrentView.Assign(FRenderCache.Items[FCurrentFrameIndex].Bitmap);
|
|
|
+ End
|
|
|
+ Else If FCurrentFrameIndex > 0 Then
|
|
|
+ Begin
|
|
|
+ Inc(FCurrentFrameIndex);
|
|
|
+ Continue;
|
|
|
+ End;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ FCurrentView.Assign(FRenderCache.Items[FCurrentFrameIndex].Bitmap);
|
|
|
+ end;
|
|
|
+ Break;
|
|
|
+ until False;
|
|
|
+
|
|
|
+ FAnimateTimer.Interval := FRenderCache.Items[FCurrentFrameIndex].Delay;
|
|
|
+ end;
|
|
|
+ Invalidate;
|
|
|
+end;
|
|
|
+
|
|
|
+Procedure TGIFViewer.PriorFrame;
|
|
|
+begin
|
|
|
+ if FCurrentFrameIndex > 0 then
|
|
|
+ begin
|
|
|
+ Dec(FCurrentFrameIndex);
|
|
|
+
|
|
|
+ repeat
|
|
|
+ If Assigned(FOnFrameChange) Then FOnFrameChange(Self);
|
|
|
+
|
|
|
+ if not(FDisplayInvalidFrames) then
|
|
|
+ begin
|
|
|
+ if not(FRenderCache.Items[FCurrentFrameIndex].IsCorrupted) then
|
|
|
+ begin
|
|
|
+ FCurrentView.Assign(FRenderCache.Items[FCurrentFrameIndex].Bitmap);
|
|
|
+ End
|
|
|
+ Else If FCurrentFrameIndex > 0 Then
|
|
|
+ Begin
|
|
|
+ Dec(FCurrentFrameIndex);
|
|
|
+ Continue;
|
|
|
+ End;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ FCurrentView.Assign(FRenderCache.Items[FCurrentFrameIndex].Bitmap);
|
|
|
+ end;
|
|
|
+ Break;
|
|
|
+ until False;
|
|
|
+
|
|
|
+ FAnimateTimer.Interval := FRenderCache.Items[FCurrentFrameIndex].Delay;
|
|
|
+ end;
|
|
|
+ Invalidate;
|
|
|
+end;
|
|
|
+
|
|
|
+Function TGIFViewer.GetRawFrame(Index: Integer): TBitmap;
|
|
|
+Begin
|
|
|
+ Result := FGIFLoader.Frames[Index].Bitmap.GetBitmap;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.DisplayFrame(Index: Integer);
|
|
|
+Begin
|
|
|
+ If not(FRenderCache.IsIndexOk(Index)) then exit;
|
|
|
+ if Not(DisplayInvalidFrames) then
|
|
|
+ begin
|
|
|
+ if FRenderCache.Items[Index].IsCorrupted then
|
|
|
+ begin
|
|
|
+ inc(Index);
|
|
|
+ DisplayFrame(Index);
|
|
|
+ End
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ FCurrentView.Assign(FRenderCache.Items[Index].Bitmap);
|
|
|
+ End;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ FCurrentView.Assign(FRenderCache.Items[Index].Bitmap);
|
|
|
+ End;
|
|
|
+ Invalidate;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.DisplayRawFrame(Index: Integer);
|
|
|
+Var
|
|
|
+ Tmp: Graphics.TBitmap;
|
|
|
+Begin
|
|
|
+ If not(FRenderCache.IsIndexOk(Index)) Then exit;
|
|
|
+ Tmp := GetRawFrame(Index);
|
|
|
+ FCurrentView.Assign(Tmp);
|
|
|
+ FreeAndNil(Tmp);
|
|
|
+ Invalidate;
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.ExtractFrame(Index: Integer; Var bmp: TBitmap);
|
|
|
+Begin
|
|
|
+ If not(FRenderCache.IsIndexOk(Index)) then exit;
|
|
|
+ Bmp.Assign(FRenderCache.Items[Index].Bitmap);
|
|
|
+End;
|
|
|
+
|
|
|
+Procedure TGIFViewer.ExtractRawFrame(Index: Integer; Var bmp: TBitmap);
|
|
|
+Var
|
|
|
+ Tmp: Graphics.TBitmap;
|
|
|
+Begin
|
|
|
+ If not(FRenderCache.IsIndexOk(Index)) Then exit;
|
|
|
+ Tmp := GetRawFrame(Index);
|
|
|
+ Bmp.Assign(Tmp);
|
|
|
+ FreeAndNil(Tmp);
|
|
|
+End;
|
|
|
+
|
|
|
+{%endregion}
|
|
|
+
|
|
|
+Procedure Register;
|
|
|
+Begin
|
|
|
+ RegisterComponents('Misc', [TGIFView]);
|
|
|
+End;
|
|
|
+
|
|
|
+End.
|
Alexander Koblov
