unit GIFImage;

////////////////////////////////////////////////////////////////////////////////

//                                                                            //

// Project:	GIF Graphics Object                                           //

// Module:	gifimage                                                      //

// Description:	TGraphic implementation of the GIF89a graphics format         //

// Version:	2.2                                                           //

// Release:	5                                                             //

// Date:	23-MAY-1999                                                   //

// Target:	Win32, Delphi 2, 3, 4 & 5, C++ Builder 3 & 4                  //

// Author(s):	anme: Anders Melander, anders@melander.dk                     //

//		fila: Filip Larsen                                            //

//		rps: Reinier Sterkenburg                                      //

// Copyright:	(c) 1997-99 Anders Melander.                                  //

//		All rights reserved.                                          //

// Formatting:	2 space indent, 8 space tabs, 80 columns.                     //

//                                                                            //

////////////////////////////////////////////////////////////////////////////////

// Changed 2001.07.23 by Finn Tolderlund:                                     //

// Changed according to e-mail from "Rolf Frei" <rolf@eicom.ch>               //

//   on 2001.07.23 so that it works in Delphi 6.                              //

//                                                                            //

// Changed 2002.07.07 by Finn Tolderlund:                                     //

// Incorporated additional modifications by Alexey Barkovoy (clootie@reactor.ru)

// found in his Delphi 6 GifImage.pas (from 22-Dec-2001).                     //

// Alexey Barkovoy's Delphi 6 gifimage.pas can be downloaded from             //

//   http://clootie.narod.ru/delphi/download_vcl.html                         //

// These changes made showing of animated gif files more stable. The code     //

// from 2001.07.23 could crash sometimes with an Execption EAccessViolation.  //

//                                                                            //

// Changed 2002.10.06 by Finn Tolderlund:                                     //

// Delphi 7 compatible.                                                       //

//                                                                            //

// Changed 2003-03-06 by Finn Tolderlund:                                     //

// Changes made as a result of postings in borland.public.delphi.graphics     //

// from 2003-02-28 to 2003-03-05 where white (255,255,255) in a bitmap        //

// was converted to (254,254,254) in the gif.                                 //

// The doCreateOptimizedPaletteFromSingleBitmap function and                  //

// the CreateOptimizedPaletteFromManyBitmaps function is changed so that      //

// the correct offset 246 is used instead of 245.                             //

// The ReduceColors function is changed according to Anders Melander's post   //

// so that a colour get converted to the precise colour if that colour is     //

// present in the palette when using ColorReduction rmQuantize.               //

//                                                                            //

// Changed 2003-03-09 by Finn Tolderlund:                                     //

// Delphi 7 version is now assumed if unknown compiler version is unknown     //

// for better compatibility with future Delphi versions.                      //

// Hopefully this code is now compatible with future Delphi versions,         //

// unless Borland makes some changes that breaks existing code.               //

//                                                                            //

// Changed 2003-08-04 by Finn Tolderlund:                                     //

// Changed procedure AddMaskOnly so that it doesn't leak a GDI HBitmap-object //

// and it doesn't release the handle of the source bitmap which               //

// is used to assign to the GIF object as in gif.assign(bm);                  //

// These changes were made as a result of a news post made by Renate Schaaf   //

// with the subject "TGifImage HBitmap leak on assign?"                       //

// in borland.public.delphi.graphics on Mon 28 Jul 2003 and Sun 03 Aug 2003.  //

//                                                                            //

// Changed 2004.03.09 by Finn Tolderlund:                                     //

// Added a ForceFrame property to the TGIFImage class.                        //

// The ForceFrame property can be used to make TGIFImage display a apecific   //

// sub frame from an animated gif.                                            //

// How to use: Set the Animate property to False and set the ForceFrame       //

// property to a desired frame number (0-N)                                   //

// Normal display: Set the ForceFrame property to -1 and set Animate to True. //

// If ForceFrame is negative TGIFImage behaves just as before this change.    //

// Note that if the sub frame in the gif only contains part of the image      //

// (i.e. only the changes from previous frames) the result is unpredictable.  //

// The result is best if each sub frame contains a whole image.               //

// If the sub frame is transparent the background is not automatically        //

// restored, you must do so yourself if you want that.                        //

// If you are using a TImage to display the gif you can use                   //

// Image.Parent.Invalidate or Image.Parent.Refresh to restore the background. //

// This change was made as a result of a email correspondance with            //

// Tineke Kosmis (http://www.classe.nl/) which requested such a property.     //

//                                                                            //

// Changed 2006.07.09 by Finn Tolderlund:                                     //

// Added conditional switch as default: FIXHEADER_WIDTHHEIGHT_SILENT          //

// When the switch is defined:                                                //

// When loading a gif all frames are examined. If a frame has a larger        //

// Width/Height than the header values then the header values are updated     //

// with the larger values from the frame.                                     //

// I had a MANTA.GIF where the header said 120x89 but the frames said 200x148 //

// and the frames got clipped. MSIE didn't clip it.                           //

// http://www.graphcomp.com/info/specs/ani_gif.html :                         //

// Do not assume all of your images are the same size. Read through their     //

// sizes and set the logical screen to the largest width & height included    //

// in the file.                                                               //

// By removing the define FIXHEADER_WIDTHHEIGHT_SILENT                        //

// the header is not altered. This makes the unit work as before.             //

//                                                                            //

// Changed 2006.07.10 by Finn Tolderlund:                                     //

// Added conditional switch as default: DEFAULT_GOCLEARLOOP                   //

// When the switch is defined:                                                //

// When loading a gif default DrawOptions include goClearLoop                 //

// Same as adding goClearLoop manually to DrawOptions.                        //

// This will clear an animated gif before first frame on each loop.           //

// Someone sent me a 'conductor.gif' where some of the last frame was retaind //

// when beginning a new loop and that was visually incorrect.                 //

// Without glClearLoop the first frame may look different on the second loop  //

// because some part of the last frame could still be present.                //

// With goClearLoop the first frame will always look the same on each loop.   //

// I think the last is better.                                                //

//                                                                            //

// Changed 2006.07.29 by Finn Tolderlund:                                     //

// Added a check in procedure TGIFSubImage.Decompress to make sure that       //

// the InitialBitsPerCode variable never exeeds the value 15.                 //

// Someone sent an animated iup110296.gif (corrupt I think) which caused      //

// this unit to crash in function NextLZW because InitialBitsPerCode was 20.  //

// This fix prevents the crash and should not cause problems with other gifs. //

// Not sure that the fix is the correct way to handle it. It seems to work.   //

//                                                                            //

// Changed 2006.10.09 by Finn Tolderlund:                                     //

// Received a mail from Michael Thomas Greer with a fix that allows           //

// the TGIFSubImage.Pixels[] property to be writeable. The help file states   //

// that the Pixels property can be written, but it was read-only.             //

// Help file: "Write Pixels to change the color index of individual pixels".  //

//                                                                            //

// Changed 2006.10.16 by Finn Tolderlund:                                     //

// Received a mail from Maurizio Lotauro who was using Delphi 5 and FastMM4.  //

// FastMM4 complains about a memory leak when using Delphi 5.                 //

// I don't have Delphi 5 installed so I can't test if there really is a       //

// memory leak or if it's just FastMM4 which can't detect it correctly.       //

// The problem and fix only applies to Delphi 5 or older.                     //

// Added a fix to keep FastMM4 happy. See more at this link:                  //

// http://sourceforge.net/forum/forum.php?thread_id=1559584&forum_id=443400   //

//                                                                            //

// Changed 2007.01.18 by Finn Tolderlund:                                     //

// The ReduceColors function is changed so that it's now possible to use      //

// the TFastColorLookup class if you use ColorReduction rmQuantize.           //

// The TFastColorLookup class was removed 2003-03-06, but is introduced again //

// because Paul Lopez needed speed when adding images to a gif.               //

// This changes how rmQuantize works: It's now fast but less precise.         //

// This means:                                                                //

// Use rmQuantizeWindows to get precision, use rmQuantize if you need speed.  //

//                                                                            //

// Changed 2008.10.19 by Finn Tolderlund:                                     //

// Now compatible with Delphi 2009.                                           //

// Generally changed use of Char/PChar to AnsiChar/PAnsiChar.                 //

//                                                                            //

// Changed 2009.10.10 by Finn Tolderlund:                                     //

// Now compatible with Delphi 2010.                                           //

// Changed conditional defines to assume Delphi 2010 for future compilers.    //

// Kind thanks to Peter Johnson (www.delphidabbler.com)                       //

//                                                                            //

// Changed 2009.10.14 by Finn Tolderlund:                                     //

// Simplified the list of defines and remove a few warnings in Delphi 2006.   //

//                                                                            //

////////////////////////////////////////////////////////////////////////////////

//                                                                            //

// Please read the "Conditions of use" in the release notes.                  //

//                                                                            //

////////////////////////////////////////////////////////////////////////////////

// Known problems:

//

// * The combination of buffered, tiled and transparent draw will display the

//   background incorrectly (scaled).

//   If this is a problem for you, use non-buffered (goDirectDraw) drawing

//   instead.

//

// * The combination of non-buffered, transparent and stretched draw is

//   sometimes distorted with a pattern effect when the image is displayed

//   smaller than the real size (shrinked).

//

// * Buffered display flickers when TGIFImage is used by a transparent TImage

//   component.

//   This is a problem with TImage caused by the fact that TImage was designed

//   with static images in mind. Not much I can do about it.

//

////////////////////////////////////////////////////////////////////////////////

// To do (in rough order of priority):

// { TODO -oanme -cFeature : TImage hook for destroy notification. }

// { TODO -oanme -cFeature : TBitmap pool to limit resource consumption on Win95/98. }

// { TODO -oanme -cImprovement : Make BitsPerPixel property writable. }

// { TODO -oanme -cFeature : Visual GIF component. }

// { TODO -oanme -cImprovement : Easier method to determine DrawPainter status. }

// { TODO -oanme -cFeature : Import to 256+ color GIF. }

// { TODO -oanme -cFeature : Make some of TGIFImage's properties persistent (DrawOptions etc). }

// { TODO -oanme -cFeature : Add TGIFImage.Persistent property. Should save published properties in application extension when this options is set. }

// { TODO -oanme -cBugFix : Solution for background buffering in scrollbox. }

//

//////////////////////////////////////////////////////////////////////////////////

{$ifdef BCB}

{$ObjExportAll On}

{$endif}



interface

////////////////////////////////////////////////////////////////////////////////

//

//		Conditional Compiler Symbols

//

////////////////////////////////////////////////////////////////////////////////

(*

  DEBUG				Must be defined if any of the DEBUG_xxx

  				symbols are defined.

                                If the symbol is defined the source will not be

                                optimized and overflow- and range checks will be

                                enabled.



  DEBUG_HASHPERFORMANCE		Calculates hash table performance data.

  DEBUG_HASHFILLFACTOR		Calculates fill factor of hash table -

  				Interferes with DEBUG_HASHPERFORMANCE.

  DEBUG_COMPRESSPERFORMANCE	Calculates LZW compressor performance data.

  DEBUG_DECOMPRESSPERFORMANCE	Calculates LZW decompressor performance data.

  DEBUG_DITHERPERFORMANCE	Calculates color reduction performance data.

  DEBUG_DRAWPERFORMANCE		Calculates low level drawing performance data.

  				The performance data for DEBUG_DRAWPERFORMANCE

                                will be displayed when you press the Ctrl key.

  DEBUG_RENDERPERFORMANCE	Calculates performance data for the GIF to

  				bitmap converter.

  				The performance data for DEBUG_DRAWPERFORMANCE

                                will be displayed when you press the Ctrl key.



  GIF_NOSAFETY			Define this symbol to disable overflow- and

				range checks.

                                Ignored if the DEBUG symbol is defined.



  STRICT_MOZILLA		Define to mimic Mozilla as closely as possible.

  				If not defined, a slightly more "optimal"

                                implementation is used (IMHO).



  FAST_AS_HELL			Define this symbol to use strictly GIF compliant

  				(but too fast) animation timing.

                                Since our paint routines are much faster and

                                more precise timed than Mozilla's, the standard

                                GIF and Mozilla values causes animations to loop

                                faster than they would in Mozilla.

                                If the symbol is _not_ defined, an alternative

                                set of tweaked timing values will be used.

                                The tweaked values are not optimal but are based

                                on tests performed on my reference system:

                                - Windows 95

                                - 133 MHz Pentium

                                - 64Mb RAM

                                - Diamond Stealth64/V3000

                                - 1600*1200 in 256 colors

                                The alternate values can be modified if you are

                                not satisfied with my defaults (they can be

                                found a few pages down).



  REGISTER_TGIFIMAGE            Define this symbol to register TGIFImage with

  				the TPicture class and integrate with TImage.

                                This is required to be able to display GIFs in

                                the TImage component.

                                The symbol is defined by default.

                                Undefine if you use another GIF library to

                                provide GIF support for TImage.



  PIXELFORMAT_TOO_SLOW		When this symbol is defined, the internal

  				PixelFormat routines are used in some places

                                instead of TBitmap.PixelFormat.

                                The current implementation (Delphi4, Builder 3)

                                of TBitmap.PixelFormat can in some situation

                                degrade performance.

                                The symbol is defined by default.



  CREATEDIBSECTION_SLOW		If this symbol is defined, TDIBWriter will

  				use global memory as scanline storage, instead

                                of a DIB section.

                                Benchmarks have shown that a DIB section is

                                twice as slow as global memory.

                                The symbol is defined by default.

                                The symbol requires that PIXELFORMAT_TOO_SLOW

                                is defined.



  SERIALIZE_RENDER		Define this symbol to serialize threaded

  				GIF to bitmap rendering.

                                When a GIF is displayed with the goAsync option

                                (the default), the GIF to bitmap rendering is

                                executed in the context of the draw thread.

                                If more than one thread is drawing the same GIF

                                or the GIF is being modified while it is

                                animating, the GIF to bitmap rendering should be

                                serialized to guarantee that the bitmap isn't

                                modified by more than one thread at a time. If

                                SERIALIZE_RENDER is defined, the draw threads

                                uses TThread.Synchronize to serialize GIF to

                                bitmap rendering.



  FIXHEADER_WIDTHHEIGHT_SILENT  Define this symbol to adjust Width and Height

                                in the header if any of the frames has a larger

                                Width or Height.



  DEFAULT_GOCLEARLOOP           Define this symbol to clear animation on each

                                loop before first frame.

                                Same as adding goClearLoop to DrawOptions.

                                STRICT_MOZILLA does the same,

                                but STRICT_MOZILLA does something more.



*)



{$DEFINE REGISTER_TGIFIMAGE}

{$DEFINE PIXELFORMAT_TOO_SLOW}

{$DEFINE CREATEDIBSECTION_SLOW}

{$DEFINE FIXHEADER_WIDTHHEIGHT_SILENT}

{$DEFINE DEFAULT_GOCLEARLOOP}



////////////////////////////////////////////////////////////////////////////////

//

//		Determine Delphi and C++ Builder version

//

////////////////////////////////////////////////////////////////////////////////



// Delphi 1.x

{$IFDEF VER80}

  'Error: TGIFImage does not support Delphi 1.x'

{$ENDIF}



// Delphi 2.x

{$IFDEF VER90}

  {$DEFINE VER9x}

{$ENDIF}



// C++ Builder 1.x

{$IFDEF VER93}

  // Good luck...

  {$DEFINE VER9x}

{$ENDIF}



// Delphi 3.x

{$IFDEF VER100}

  {$DEFINE VER10_PLUS}

  {$DEFINE D3_BCB3}

{$ENDIF}



// C++ Builder 3.x

{$IFDEF VER110}

  {$DEFINE VER10_PLUS}

  {$DEFINE VER11_PLUS}

  {$DEFINE D3_BCB3}

  {$DEFINE BAD_STACK_ALIGNMENT}

{$ENDIF}



// Delphi 4.x

{$IFDEF VER120}

  {$DEFINE VER10_PLUS}

  {$DEFINE VER11_PLUS}

  {$DEFINE VER12_PLUS}

  {$DEFINE BAD_STACK_ALIGNMENT}

{$ENDIF}



// C++ Builder 4.x

{$IFDEF VER125}

  {$DEFINE VER10_PLUS}

  {$DEFINE VER11_PLUS}

  {$DEFINE VER12_PLUS}

  {$DEFINE VER125_PLUS}

  {$DEFINE BAD_STACK_ALIGNMENT}

{$ENDIF}



// Delphi 5.x

{$IFDEF VER130}

  {$DEFINE VER10_PLUS}

  {$DEFINE VER11_PLUS}

  {$DEFINE VER12_PLUS}

  {$DEFINE VER125_PLUS}

  {$DEFINE VER13_PLUS}

  {$DEFINE BAD_STACK_ALIGNMENT}

{$ENDIF}



(*

// Delphi 6.x

{$IFDEF VER140}

  {$WARN SYMBOL_PLATFORM OFF}

  {$DEFINE VER10_PLUS}

  {$DEFINE VER11_PLUS}

  {$DEFINE VER12_PLUS}

  {$DEFINE VER125_PLUS}

  {$DEFINE VER13_PLUS}

  {$DEFINE VER14_PLUS}

  {$DEFINE BAD_STACK_ALIGNMENT}

{$ENDIF}



// Delphi 7.x

{$IFDEF VER150}

  {$WARN SYMBOL_PLATFORM OFF}

  {$DEFINE VER10_PLUS}

  {$DEFINE VER11_PLUS}

  {$DEFINE VER12_PLUS}

  {$DEFINE VER125_PLUS}

  {$DEFINE VER13_PLUS}

  {$DEFINE VER14_PLUS}

  {$DEFINE VER15_PLUS}

  {$DEFINE BAD_STACK_ALIGNMENT}

{$ENDIF}



// 2008.10.19 ->

// Delphi 2009

{$IFDEF VER200}

  {$WARN SYMBOL_PLATFORM OFF}

  {$DEFINE VER10_PLUS}

  {$DEFINE VER11_PLUS}

  {$DEFINE VER12_PLUS}

  {$DEFINE VER125_PLUS}

  {$DEFINE VER13_PLUS}

  {$DEFINE VER14_PLUS}

  {$DEFINE VER15_PLUS}

  {$DEFINE VER20_PLUS}

  {$DEFINE BAD_STACK_ALIGNMENT}

{$ENDIF}

// 2008.10.19 <-



// 2003.03.09 ->

// Unknown compiler version - assume D7 compatible

{$IFNDEF VER9x}

{$IFNDEF VER10_PLUS}

  {$WARN SYMBOL_PLATFORM OFF}

  {$DEFINE VER10_PLUS}

  {$DEFINE VER11_PLUS}

  {$DEFINE VER12_PLUS}

  {$DEFINE VER125_PLUS}

  {$DEFINE VER13_PLUS}

  {$DEFINE VER14_PLUS}

  {$DEFINE VER15_PLUS}

  {$DEFINE BAD_STACK_ALIGNMENT}

{$ENDIF}

{$ENDIF}

// 2003.03.09 <-



// 2009.10.10 ->

// This ensures that future compilers always have same defines as latest compiler listed here.

{$IFDEF CONDITIONALEXPRESSIONS}

  {$IF CompilerVersion >= 21.0}   // >= Delphi 2010

    {$WARN SYMBOL_PLATFORM OFF}

    {$WARN SYMBOL_DEPRECATED OFF}

    {$DEFINE VER10_PLUS}

    {$DEFINE VER11_PLUS}

    {$DEFINE VER12_PLUS}

    {$DEFINE VER125_PLUS}

    {$DEFINE VER13_PLUS}

    {$DEFINE VER14_PLUS}

    {$DEFINE VER15_PLUS}

    {$DEFINE VER20_PLUS}

    {$DEFINE BAD_STACK_ALIGNMENT}

    {$DEFINE VER21_PLUS}

  {$IFEND}

{$ENDIF}

// 2009.10.10 <-

*)



// 2009.10.14 ->

// This ensures that future compilers always have same defines as latest compiler listed here.

{$IFDEF CONDITIONALEXPRESSIONS}

   {$IF CompilerVersion >= 14.0}   // >= Delphi 6

     {$WARN SYMBOL_PLATFORM OFF}

     {$WARN SYMBOL_DEPRECATED OFF}

     {$DEFINE VER10_PLUS}

     {$DEFINE VER11_PLUS}

     {$DEFINE VER12_PLUS}

     {$DEFINE VER125_PLUS}

     {$DEFINE VER13_PLUS}

     {$DEFINE VER14_PLUS}

     {$DEFINE BAD_STACK_ALIGNMENT}

   {$IFEND}

   {$IF CompilerVersion >= 15.0}   // >= Delphi 7

     {$DEFINE VER15_PLUS}

   {$IFEND}

   {$IF CompilerVersion >= 20.0}   // >= Delphi 2009

     {$DEFINE VER20_PLUS}

   {$IFEND}

   {$IF CompilerVersion >= 21.0}   // >= Delphi 2010

     {$DEFINE VER21_PLUS}

   {$IFEND}

{$ENDIF}

// 2009.10.14 <-



////////////////////////////////////////////////////////////////////////////////

//

//		Compiler Options required to compile this library

//

////////////////////////////////////////////////////////////////////////////////

{$A+,B-,H+,J+,K-,M-,T-,X+}



// Debug control - You can safely change these settings

{$IFDEF DEBUG}

  {$C+}	// ASSERTIONS

  {$O-}	// OPTIMIZATION

  {$Q+}	// OVERFLOWCHECKS

  {$R+}	// RANGECHECKS

{$ELSE}

  {$C-}	// ASSERTIONS

  {$IFDEF GIF_NOSAFETY}

    {$Q-}// OVERFLOWCHECKS

    {$R-}// RANGECHECKS

  {$ENDIF}

{$ENDIF}



// Special options for Time2Help parser

{$ifdef TIME2HELP}

{$UNDEF PIXELFORMAT_TOO_SLOW}

{$endif}



////////////////////////////////////////////////////////////////////////////////

//

//			External dependecies

//

////////////////////////////////////////////////////////////////////////////////

uses

  sysutils,

  Windows,

  Graphics,

  Classes;



////////////////////////////////////////////////////////////////////////////////

//

//			TGIFImage library version

//

////////////////////////////////////////////////////////////////////////////////

const

  GIFVersion		= $0202;

  GIFVersionMajor	= 2;

  GIFVersionMinor	= 2;

  GIFVersionRelease	= 5;



////////////////////////////////////////////////////////////////////////////////

//

//			Misc constants and support types

//

////////////////////////////////////////////////////////////////////////////////

const

  GIFMaxColors	= 256;			// Max number of colors supported by GIF

  					// Don't bother changing this value!



  BitmapAllocationThreshold = 500000;	// Bitmap pixel count limit at which

  					// a newly allocated bitmap will be

                                        // converted to 1 bit format before

                                        // being resized and converted to 8 bit.



var

{$IFDEF FAST_AS_HELL}

  GIFDelayExp: integer = 10;		// Delay multiplier in mS.

{$ELSE}

  GIFDelayExp: integer = 12;		// Delay multiplier in mS. Tweaked.

{$ENDIF}

					// * GIFDelayExp:

  					// The following delay values should all

                                        // be multiplied by this value to

                                        // calculate the effective time (in mS).

                                        // According to the GIF specs, this

                                        // value should be 10.

                                        // Since our paint routines are much

                                        // faster than Mozilla's, you might need

                                        // to increase this value if your

                                        // animations loops too fast. The

                                        // optimal value is impossible to

                                        // determine since it depends on the

                                        // speed of the CPU, the viceo card,

                                        // memory and many other factors.



  GIFDefaultDelay: integer = 10;	// * GIFDefaultDelay:

  					// Default animation delay.

  					// This value is used if no GCE is

                                        // defined.

                                        // (10 = 100 mS)



{$IFDEF FAST_AS_HELL}

  GIFMinimumDelay: integer = 1;		// Minimum delay (from Mozilla source).

  					// (1 = 10 mS)

{$ELSE}

  GIFMinimumDelay: integer = 3;		// Minimum delay - Tweaked.

{$ENDIF}

					// * GIFMinimumDelay:

					// The minumum delay used in the Mozilla

                                        // source is 10mS. This corresponds to a

                                        // value of 1. However, since our paint

                                        // routines are much faster than

                                        // Mozilla's, a value of 3 or 4 gives

                                        // better results.



  GIFMaximumDelay: integer = 1000;	// * GIFMaximumDelay:

  					// Maximum delay when painter is running

  					// in main thread (goAsync is not set).

                                        // This value guarantees that a very

                                        // long and slow GIF does not hang the

                                        // system.

                                        // (1000 = 10000 mS = 10 Seconds)



type

  TGIFVersion = (gvUnknown, gv87a, gv89a);

  TGIFVersionRec = array[0..2] of AnsiChar;



const

  GIFVersions : array[gv87a..gv89a] of TGIFVersionRec = ('87a', '89a');



type

  // TGIFImage mostly throws exceptions of type GIFException

  GIFException = class(EInvalidGraphic);



  // Severity level as indicated in the Warning methods and the OnWarning event

  TGIFSeverity = (gsInfo, gsWarning, gsError);



////////////////////////////////////////////////////////////////////////////////

//

//			Delphi 2.x support

//

////////////////////////////////////////////////////////////////////////////////

{$IFDEF VER9x}

// Delphi 2 doesn't support TBitmap.PixelFormat

{$DEFINE PIXELFORMAT_TOO_SLOW}

type

  // TThreadList from Delphi 3 classes.pas

  TThreadList = class

  private

    FList: TList;

    FLock: TRTLCriticalSection;

  public

    constructor Create;

    destructor Destroy; override;

    procedure Add(Item: Pointer);

    procedure Clear;

    function  LockList: TList;

    procedure Remove(Item: Pointer);

    procedure UnlockList;

  end;



  // From Delphi 3 sysutils.pas

  EOutOfMemory = class(Exception);



  // From Delphi 3 classes.pas

  EOutOfResources = class(EOutOfMemory);



  // From Delphi 3 windows.pas

  PMaxLogPalette = ^TMaxLogPalette;

  TMaxLogPalette = packed record

    palVersion: Word;

    palNumEntries: Word;

    palPalEntry: array [Byte] of TPaletteEntry;

  end; { TMaxLogPalette }



  // From Delphi 3 graphics.pas. Used by the D3 TGraphic class.

  TProgressStage = (psStarting, psRunning, psEnding);

  TProgressEvent = procedure (Sender: TObject; Stage: TProgressStage;

    PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string) of object;



  // From Delphi 3 windows.pas

  PRGBTriple = ^TRGBTriple;

{$ENDIF}



////////////////////////////////////////////////////////////////////////////////

//

//			Forward declarations

//

////////////////////////////////////////////////////////////////////////////////

type

  TGIFImage = class;

  TGIFSubImage = class;



////////////////////////////////////////////////////////////////////////////////

//

//			TGIFItem

//

////////////////////////////////////////////////////////////////////////////////

  TGIFItem = class(TPersistent)

  private

    FGIFImage: TGIFImage;

  protected

    function GetVersion: TGIFVersion; virtual;

    procedure Warning(Severity: TGIFSeverity; Message: string); virtual;

  public

    constructor Create(GIFImage: TGIFImage); virtual;



    procedure SaveToStream(Stream: TStream); virtual; abstract;

    procedure LoadFromStream(Stream: TStream); virtual; abstract;

    procedure SaveToFile(const Filename: string); virtual;

    procedure LoadFromFile(const Filename: string); virtual;

    property Version: TGIFVersion read GetVersion;

    property Image: TGIFImage read FGIFImage;

  end;



////////////////////////////////////////////////////////////////////////////////

//

//			TGIFList

//

////////////////////////////////////////////////////////////////////////////////

  TGIFList = class(TPersistent)

  private

    FItems: TList;

    FImage: TGIFImage;

  protected

    function GetItem(Index: Integer): TGIFItem;

    procedure SetItem(Index: Integer; Item: TGIFItem);

    function GetCount: Integer;

    procedure Warning(Severity: TGIFSeverity; Message: string); virtual;

  public

    constructor Create(Image: TGIFImage);

    destructor Destroy; override;



    function Add(Item: TGIFItem): Integer;

    procedure Clear;

    procedure Delete(Index: Integer);

    procedure Exchange(Index1, Index2: Integer);

    function First: TGIFItem;

    function IndexOf(Item: TGIFItem): Integer;

    procedure Insert(Index: Integer; Item: TGIFItem);

    function Last: TGIFItem;

    procedure Move(CurIndex, NewIndex: Integer);

    function Remove(Item: TGIFItem): Integer;

    procedure SaveToStream(Stream: TStream); virtual;

    procedure LoadFromStream(Stream: TStream; Parent: TObject); virtual; abstract;



    property Items[Index: Integer]: TGIFItem read GetItem write SetItem; default;

    property Count: Integer read GetCount;

    property List: TList read FItems;

    property Image: TGIFImage read FImage;

  end;



////////////////////////////////////////////////////////////////////////////////

//

//			TGIFColorMap

//

////////////////////////////////////////////////////////////////////////////////

  // One way to do it:

  //  TBaseColor = (bcRed, bcGreen, bcBlue);

  //  TGIFColor = array[bcRed..bcBlue] of BYTE;

  // Another way:

  TGIFColor = packed record

    Red: byte;

    Green: byte;

    Blue: byte;

  end;



  TColorMap = packed array[0..GIFMaxColors-1] of TGIFColor;

  PColorMap = ^TColorMap;



  TUsageCount = record

    Count		: integer;	// # of pixels using color index

    Index		: integer;	// Color index

  end;

  TColormapHistogram = array[0..255] of TUsageCount;

  TColormapReverse = array[0..255] of byte;



  TGIFColorMap = class(TPersistent)

  private

    FColorMap		: PColorMap;

    FCount		: integer;

    FCapacity		: integer;

    FOptimized		: boolean;

  protected

    function GetColor(Index: integer): TColor;

    procedure SetColor(Index: integer; Value: TColor);

    function GetBitsPerPixel: integer;

    function DoOptimize: boolean;

    procedure SetCapacity(Size: integer);

    procedure Warning(Severity: TGIFSeverity; Message: string); virtual; abstract;

    procedure BuildHistogram(var Histogram: TColormapHistogram); virtual; abstract;

    procedure MapImages(var Map: TColormapReverse); virtual; abstract;



  public

    constructor Create;

    destructor Destroy; override;

    class function Color2RGB(Color: TColor): TGIFColor;

    class function RGB2Color(Color: TGIFColor): TColor;

    procedure SaveToStream(Stream: TStream);

    procedure LoadFromStream(Stream: TStream; Count: integer);

    procedure Assign(Source: TPersistent); override;

    function IndexOf(Color: TColor): integer;

    function Add(Color: TColor): integer;

    function AddUnique(Color: TColor): integer;

    procedure Delete(Index: integer);

    procedure Clear;

    function Optimize: boolean; virtual; abstract;

    procedure Changed; virtual; abstract;

    procedure ImportPalette(Palette: HPalette);

    procedure ImportColorTable(Pal: pointer; Count: integer);

    procedure ImportDIBColors(Handle: HDC);

    procedure ImportColorMap(Map: TColorMap; Count: integer);

    function ExportPalette: HPalette;

    property Colors[Index: integer]: TColor read GetColor write SetColor; default;

    property Data: PColorMap read FColorMap;

    property Count: integer read FCount;

    property Optimized: boolean read FOptimized write FOptimized;

    property BitsPerPixel: integer read GetBitsPerPixel;

  end;



////////////////////////////////////////////////////////////////////////////////

//

//			TGIFHeader

//

////////////////////////////////////////////////////////////////////////////////

  TLogicalScreenDescriptor = packed record

    ScreenWidth: word;              { logical screen width }

    ScreenHeight: word;             { logical screen height }

    PackedFields: byte;             { packed fields }

    BackgroundColorIndex: byte;     { index to global color table }

    AspectRatio: byte;              { actual ratio = (AspectRatio + 15) / 64 }

  end;



  TGIFHeader = class(TGIFItem)

  private

    FLogicalScreenDescriptor: TLogicalScreenDescriptor;

    FColorMap		: TGIFColorMap;

    procedure Prepare;

  protected

    function GetVersion: TGIFVersion; override;

    function GetBackgroundColor: TColor;

    procedure SetBackgroundColor(Color: TColor);

    procedure SetBackgroundColorIndex(Index: BYTE);

    function GetBitsPerPixel: integer;

    function GetColorResolution: integer;

  public

    constructor Create(GIFImage: TGIFImage); override;

    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;

    procedure SaveToStream(Stream: TStream); override;

    procedure LoadFromStream(Stream: TStream); override;

    procedure Clear;

    property Version: TGIFVersion read GetVersion;

    property Width: WORD read FLogicalScreenDescriptor.ScreenWidth

                         write FLogicalScreenDescriptor.ScreenWidth;

    property Height: WORD read FLogicalScreenDescriptor.ScreenHeight

                          write FLogicalScreenDescriptor.Screenheight;

    property BackgroundColorIndex: BYTE read FLogicalScreenDescriptor.BackgroundColorIndex

                                        write SetBackgroundColorIndex;

    property BackgroundColor: TColor read GetBackgroundColor

                                     write SetBackgroundColor;

    property AspectRatio: BYTE read FLogicalScreenDescriptor.AspectRatio

                               write FLogicalScreenDescriptor.AspectRatio;

    property ColorMap: TGIFColorMap read FColorMap;

    property BitsPerPixel: integer read GetBitsPerPixel;

    property ColorResolution: integer read GetColorResolution;

  end;



////////////////////////////////////////////////////////////////////////////////

//

//                      TGIFExtension

//

////////////////////////////////////////////////////////////////////////////////

  TGIFExtensionType = BYTE;

  TGIFExtension = class;

  TGIFExtensionClass = class of TGIFExtension;



  TGIFGraphicControlExtension = class;



  TGIFExtension = class(TGIFItem)

  private

    FSubImage: TGIFSubImage;

  protected

    function GetExtensionType: TGIFExtensionType; virtual; abstract;

    function GetVersion: TGIFVersion; override;

    function DoReadFromStream(Stream: TStream): TGIFExtensionType;

    class procedure RegisterExtension(elabel: BYTE; eClass: TGIFExtensionClass);

    class function FindExtension(Stream: TStream): TGIFExtensionClass;

    class function FindSubExtension(Stream: TStream): TGIFExtensionClass; virtual;

  public

     // Ignore compiler warning about hiding base class constructor

    constructor Create(ASubImage: TGIFSubImage); {$IFDEF VER12_PLUS} reintroduce; {$ENDIF} virtual;

    destructor Destroy; override;

    procedure SaveToStream(Stream: TStream); override;

    procedure LoadFromStream(Stream: TStream); override;

    property ExtensionType: TGIFExtensionType read GetExtensionType;

    property SubImage: TGIFSubImage read FSubImage;

  end;



////////////////////////////////////////////////////////////////////////////////

//

//			TGIFSubImage

//

////////////////////////////////////////////////////////////////////////////////

  TGIFExtensionList = class(TGIFList)

  protected

    function GetExtension(Index: Integer): TGIFExtension;

    procedure SetExtension(Index: Integer; Extension: TGIFExtension);

  public

    procedure LoadFromStream(Stream: TStream; Parent: TObject); override;

    property Extensions[Index: Integer]: TGIFExtension read GetExtension write SetExtension; default;

  end;



  TImageDescriptor = packed record

    Separator: byte;	{ fixed value of ImageSeparator }

    Left: word;		{ Column in pixels in respect to left edge of logical screen }

    Top: word;		{ row in pixels in respect to top of logical screen }

    Width: word;	{ width of image in pixels }

    Height: word;	{ height of image in pixels }

    PackedFields: byte;	{ Bit fields }

  end;



  TGIFSubImage = class(TGIFItem)

  private

    FBitmap		: TBitmap;

    FMask		: HBitmap;

    FNeedMask		: boolean;

    FLocalPalette	: HPalette;

    FData		: PAnsiChar;

    FDataSize		: integer;

    FColorMap		: TGIFColorMap;

    FImageDescriptor	: TImageDescriptor;

    FExtensions		: TGIFExtensionList;

    FTransparent	: boolean;

    FGCE		: TGIFGraphicControlExtension;

    procedure Prepare;

    procedure Compress(Stream: TStream);

    procedure Decompress(Stream: TStream);

  protected

    function GetVersion: TGIFVersion; override;

    function GetInterlaced: boolean;

    procedure SetInterlaced(Value: boolean);

    function GetColorResolution: integer;

    function GetBitsPerPixel: integer;

    procedure AssignTo(Dest: TPersistent); override;

    function DoGetBitmap: TBitmap;

    function DoGetDitherBitmap: TBitmap;

    function GetBitmap: TBitmap;

    procedure SetBitmap(Value: TBitmap);

    procedure FreeMask;

    function GetEmpty: Boolean;

    function GetPalette: HPALETTE;

    procedure SetPalette(Value: HPalette);

    function GetActiveColorMap: TGIFColorMap;

    function GetBoundsRect: TRect;

    procedure SetBoundsRect(const Value: TRect);

    procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer);

    function GetClientRect: TRect;

    function GetPixel(x, y: integer): BYTE;

// 2006.10.09 ->

    procedure SetPixel(x, y: integer; Value: BYTE);

// 2006.10.09 <-

    function GetScanline(y: integer): pointer;

    procedure NewBitmap;

    procedure FreeBitmap;

    procedure NewImage;

    procedure FreeImage;

    procedure NeedImage;

    function ScaleRect(DestRect: TRect): TRect;

    function HasMask: boolean;

    function GetBounds(Index: integer): WORD;

    procedure SetBounds(Index: integer; Value: WORD);

    function GetHasBitmap: boolean;

    procedure SetHasBitmap(Value: boolean);

  public

    constructor Create(GIFImage: TGIFImage); override;

    destructor Destroy; override;

    procedure Clear;

    procedure SaveToStream(Stream: TStream); override;

    procedure LoadFromStream(Stream: TStream); override;

    procedure Assign(Source: TPersistent); override;

    procedure Draw(ACanvas: TCanvas; const Rect: TRect;

      DoTransparent, DoTile: boolean);

    procedure StretchDraw(ACanvas: TCanvas; const Rect: TRect;

      DoTransparent, DoTile: boolean);

    procedure Crop;

    procedure Merge(Previous: TGIFSubImage);

    property HasBitmap: boolean read GetHasBitmap write SetHasBitmap;

    property Left: WORD index 1 read GetBounds write SetBounds;

    property Top: WORD index 2 read GetBounds write SetBounds;

    property Width: WORD index 3 read GetBounds write SetBounds;

    property Height: WORD index 4 read GetBounds write SetBounds;

    property BoundsRect: TRect read GetBoundsRect write SetBoundsRect;

    property ClientRect: TRect read GetClientRect;

    property Interlaced: boolean read GetInterlaced write SetInterlaced;

    property ColorMap: TGIFColorMap read FColorMap;

    property ActiveColorMap: TGIFColorMap read GetActiveColorMap;

    property Data: PAnsiChar read FData;

    property DataSize: integer read FDataSize;

    property Extensions: TGIFExtensionList read FExtensions;

    property Version: TGIFVersion read GetVersion;

    property ColorResolution: integer read GetColorResolution;

    property BitsPerPixel: integer read GetBitsPerPixel;

    property Bitmap: TBitmap read GetBitmap write SetBitmap;

    property Mask: HBitmap read FMask;

    property Palette: HPALETTE read GetPalette write SetPalette;

    property Empty: boolean read GetEmpty;

    property Transparent: boolean read FTransparent;

    property GraphicControlExtension: TGIFGraphicControlExtension read FGCE;

// 2006.10.09 ->

//  property Pixels[x, y: integer]: BYTE read GetPixel;

    property Pixels[x, y: integer]: BYTE read GetPixel write SetPixel;

// 2006.10.09 <-

    property Scanline[y: integer]: pointer read GetScanline;

  end;



////////////////////////////////////////////////////////////////////////////////

//

//                      TGIFTrailer

//

////////////////////////////////////////////////////////////////////////////////

  TGIFTrailer = class(TGIFItem)

    procedure SaveToStream(Stream: TStream); override;

    procedure LoadFromStream(Stream: TStream); override;

  end;



////////////////////////////////////////////////////////////////////////////////

//

//                      TGIFGraphicControlExtension

//

////////////////////////////////////////////////////////////////////////////////

  // Graphic Control Extension block a.k.a GCE

  TGIFGCERec = packed record

    BlockSize: byte;         { should be 4 }

    PackedFields: Byte;

    DelayTime: Word;         { in centiseconds }

    TransparentColorIndex: Byte;

    Terminator: Byte;

  end;



  TDisposalMethod = (dmNone, dmNoDisposal, dmBackground, dmPrevious);



  TGIFGraphicControlExtension = class(TGIFExtension)

  private

    FGCExtension: TGIFGCERec;

  protected

    function GetExtensionType: TGIFExtensionType; override;

    function GetTransparent: boolean;

    procedure SetTransparent(Value: boolean);

    function GetTransparentColor: TColor;

    procedure SetTransparentColor(Color: TColor);

    function GetTransparentColorIndex: BYTE;

    procedure SetTransparentColorIndex(Value: BYTE);

    function GetDelay: WORD;

    procedure SetDelay(Value: WORD);

    function GetUserInput: boolean;

    procedure SetUserInput(Value: boolean);

    function GetDisposal: TDisposalMethod;

    procedure SetDisposal(Value: TDisposalMethod);



  public

    constructor Create(ASubImage: TGIFSubImage); override;

    destructor Destroy; override;

    procedure SaveToStream(Stream: TStream); override;

    procedure LoadFromStream(Stream: TStream); override;

    property Delay: WORD read GetDelay write SetDelay;

    property Transparent: boolean read GetTransparent write SetTransparent;

    property TransparentColorIndex: BYTE read GetTransparentColorIndex

                                            write SetTransparentColorIndex;

    property TransparentColor: TColor read GetTransparentColor write SetTransparentColor;

    property UserInput: boolean read GetUserInput write SetUserInput;

    property Disposal: TDisposalMethod read GetDisposal write SetDisposal;

  end;



////////////////////////////////////////////////////////////////////////////////

//

//                      TGIFTextExtension

//

////////////////////////////////////////////////////////////////////////////////

  TGIFPlainTextExtensionRec = packed record

    BlockSize: byte;         { should be 12 }

    Left, Top, Width, Height: Word;

    CellWidth, CellHeight: Byte;

    TextFGColorIndex,

    TextBGColorIndex: Byte;

  end;



  TGIFTextExtension = class(TGIFExtension)

  private

    FText		: TStrings;

    FPlainTextExtension	: TGIFPlainTextExtensionRec;

  protected

    function GetExtensionType: TGIFExtensionType; override;

    function GetForegroundColor: TColor;

    procedure SetForegroundColor(Color: TColor);

    function GetBackgroundColor: TColor;

    procedure SetBackgroundColor(Color: TColor);

    function GetBounds(Index: integer): WORD;

    procedure SetBounds(Index: integer; Value: WORD);

    function GetCharWidthHeight(Index: integer): BYTE;

    procedure SetCharWidthHeight(Index: integer; Value: BYTE);

    function GetColorIndex(Index: integer): BYTE;

    procedure SetColorIndex(Index: integer; Value: BYTE);

  public

    constructor Create(ASubImage: TGIFSubImage); override;

    destructor Destroy; override;

    procedure SaveToStream(Stream: TStream); override;

    procedure LoadFromStream(Stream: TStream); override;

    property Left: WORD index 1 read GetBounds write SetBounds;

    property Top: WORD index 2 read GetBounds write SetBounds;

    property GridWidth: WORD index 3 read GetBounds write SetBounds;

    property GridHeight: WORD index 4 read GetBounds write SetBounds;

    property CharWidth: BYTE index 1 read GetCharWidthHeight write SetCharWidthHeight;

    property CharHeight: BYTE index 2 read GetCharWidthHeight write SetCharWidthHeight;

    property ForegroundColorIndex: BYTE index 1 read GetColorIndex write SetColorIndex;

    property ForegroundColor: TColor read GetForegroundColor;

    property BackgroundColorIndex: BYTE  index 2 read GetColorIndex write SetColorIndex;

    property BackgroundColor: TColor read GetBackgroundColor;

    property Text: TStrings read FText write FText;

  end;



////////////////////////////////////////////////////////////////////////////////

//

//                      TGIFCommentExtension

//

////////////////////////////////////////////////////////////////////////////////

  TGIFCommentExtension = class(TGIFExtension)

  private

    FText		: TStrings;

  protected

    function GetExtensionType: TGIFExtensionType; override;

  public

    constructor Create(ASubImage: TGIFSubImage); override;

    destructor Destroy; override;

    procedure SaveToStream(Stream: TStream); override;

    procedure LoadFromStream(Stream: TStream); override;

    property Text: TStrings read FText;

  end;



////////////////////////////////////////////////////////////////////////////////

//

//                      TGIFApplicationExtension

//

////////////////////////////////////////////////////////////////////////////////

  TGIFIdentifierCode = array[0..7] of AnsiChar;

  TGIFAuthenticationCode = array[0..2] of AnsiChar;

  TGIFApplicationRec = packed record

    Identifier		: TGIFIdentifierCode;

    Authentication	: TGIFAuthenticationCode;

  end;



  TGIFApplicationExtension = class;

  TGIFAppExtensionClass = class of TGIFApplicationExtension;



  TGIFApplicationExtension = class(TGIFExtension)

  private

    FIdent		: TGIFApplicationRec;

    function GetAuthentication: AnsiString;

    function GetIdentifier: AnsiString;

  protected

    function GetExtensionType: TGIFExtensionType; override;

    procedure SetAuthentication(const Value: AnsiString);

    procedure SetIdentifier(const Value: AnsiString);

    procedure SaveData(Stream: TStream); virtual; abstract;

    procedure LoadData(Stream: TStream); virtual; abstract;

  public

    constructor Create(ASubImage: TGIFSubImage); override;

    destructor Destroy; override;

    procedure SaveToStream(Stream: TStream); override;

    procedure LoadFromStream(Stream: TStream); override;

    class procedure RegisterExtension(eIdent: TGIFApplicationRec; eClass: TGIFAppExtensionClass);

    class function FindSubExtension(Stream: TStream): TGIFExtensionClass; override;

    property Identifier: AnsiString read GetIdentifier write SetIdentifier;

    property Authentication: AnsiString read GetAuthentication write SetAuthentication;

  end;



////////////////////////////////////////////////////////////////////////////////

//

//                      TGIFUnknownAppExtension

//

////////////////////////////////////////////////////////////////////////////////

  TGIFBlock = class(TObject)

  private

    FSize		: BYTE;

    FData		: pointer;

  public

    constructor Create(ASize: integer);

    destructor Destroy; override;

    procedure SaveToStream(Stream: TStream);

    procedure LoadFromStream(Stream: TStream);

    property Size: BYTE read FSize;

    property Data: pointer read FData;

  end;



  TGIFUnknownAppExtension = class(TGIFApplicationExtension)

  private

    FBlocks		: TList;

  protected

    procedure SaveData(Stream: TStream); override;

    procedure LoadData(Stream: TStream); override;

  public

    constructor Create(ASubImage: TGIFSubImage); override;

    destructor Destroy; override;

    property Blocks: TList read FBlocks;

  end;



////////////////////////////////////////////////////////////////////////////////

//

//                      TGIFAppExtNSLoop

//

////////////////////////////////////////////////////////////////////////////////

  TGIFAppExtNSLoop = class(TGIFApplicationExtension)

  private

    FLoops		: WORD;

    FBufferSize		: DWORD;

  protected

    procedure SaveData(Stream: TStream); override;

    procedure LoadData(Stream: TStream); override;

  public

    constructor Create(ASubImage: TGIFSubImage); override;

    property Loops: WORD read FLoops write FLoops;

    property BufferSize: DWORD read FBufferSize write FBufferSize;

  end;



////////////////////////////////////////////////////////////////////////////////

//

//                      TGIFImage

//

////////////////////////////////////////////////////////////////////////////////

  TGIFImageList = class(TGIFList)

  protected

    function GetImage(Index: Integer): TGIFSubImage;

    procedure SetImage(Index: Integer; SubImage: TGIFSubImage);

  public

    procedure LoadFromStream(Stream: TStream; Parent: TObject); override;

    procedure SaveToStream(Stream: TStream); override;

    property SubImages[Index: Integer]: TGIFSubImage read GetImage write SetImage; default;

  end;



  // Compression algorithms

  TGIFCompression =

    (gcLZW,			// Normal LZW compression

     gcRLE			// GIF compatible RLE compression

    );



  // Color reduction methods

  TColorReduction =

    (rmNone,			// Do not perform color reduction

     rmWindows20,		// Reduce to the Windows 20 color system palette

     rmWindows256,		// Reduce to the Windows 256 color halftone palette (Only works in 256 color display mode)

     rmWindowsGray,		// Reduce to the Windows 4 grayscale colors

     rmMonochrome,		// Reduce to a black/white monochrome palette

     rmGrayScale,		// Reduce to a uniform 256 shade grayscale palette

     rmNetscape,		// Reduce to the Netscape 216 color palette

     rmQuantize,		// Reduce to optimal 2^n color palette

     rmQuantizeWindows,		// Reduce to optimal 256 color windows palette

     rmPalette			// Reduce to custom palette

    );

  TDitherMode =

    (dmNearest,			// Nearest color matching w/o error correction

     dmFloydSteinberg,		// Floyd Steinberg Error Diffusion dithering

     dmStucki,			// Stucki Error Diffusion dithering

     dmSierra,			// Sierra Error Diffusion dithering

     dmJaJuNI,			// Jarvis, Judice & Ninke Error Diffusion dithering

     dmSteveArche,		// Stevenson & Arche Error Diffusion dithering

     dmBurkes			// Burkes Error Diffusion dithering

     // dmOrdered,		// Ordered dither

    );



  // Optimization options

  TGIFOptimizeOption =

    (ooCrop,			// Crop animated GIF frames

     ooMerge,			// Merge pixels of same color

     ooCleanup,			// Remove comments and application extensions

     ooColorMap,		// Sort color map by usage and remove unused entries

     ooReduceColors		// Reduce color depth ***NOT IMPLEMENTED***

    );

  TGIFOptimizeOptions = set of TGIFOptimizeOption;



  TGIFDrawOption =

    (goAsync,			// Asyncronous draws (paint in thread)

     goTransparent,		// Transparent draws

     goAnimate,			// Animate draws

     goLoop,			// Loop animations

     goLoopContinously,		// Ignore loop count and loop forever

     goValidateCanvas,		// Validate canvas in threaded paint ***NOT IMPLEMENTED***

     goDirectDraw,		// Draw() directly on canvas

     goClearOnLoop,		// Clear animation on loop

     goTile,			// Tiled display

     goDither,			// Dither to Netscape palette

     goAutoDither		// Only dither on 256 color systems

    );

  TGIFDrawOptions = set of TGIFDrawOption;

  // Note: if goAsync is not set then goDirectDraw should be set. Otherwise

  // the image will not be displayed.



  PGIFPainter = ^TGIFPainter;



  TGIFPainter = class(TThread)

  private

    FImage		: TGIFImage;	// The TGIFImage that owns this painter

    FCanvas		: TCanvas;	// Destination canvas

    FRect		: TRect;	// Destination rect

    FDrawOptions	: TGIFDrawOptions;// Paint options

    FAnimationSpeed	: integer;	// Animation speed %

    FActiveImage	: integer;	// Current frame

    Disposal		,		// Used by synchronized paint

    OldDisposal		: TDisposalMethod;// Used by synchronized paint

    BackupBuffer	: TBitmap;	// Used by synchronized paint

    FrameBuffer		: TBitmap;	// Used by synchronized paint

    Background		: TBitmap;	// Used by synchronized paint

    ValidateDC		: HDC;

    DoRestart		: boolean;	// Flag used to restart animation

    FStarted		: boolean;	// Flag used to signal start of paint

    PainterRef		: PGIFPainter;	// Pointer to var referencing painter

    FEventHandle	: THandle;	// Animation delay event

    ExceptObject	: Exception;	// Eaten exception

    ExceptAddress	: pointer;	// Eaten exceptions address

    FEvent		: TNotifyEvent;	// Used by synchronized events

    FOnStartPaint	: TNotifyEvent;

    FOnPaint		: TNotifyEvent;

    FOnAfterPaint	: TNotifyEvent;

    FOnLoop		: TNotifyEvent;

    FOnEndPaint		: TNotifyEvent;

    procedure DoOnTerminate(Sender: TObject);// Sync. shutdown procedure

    procedure DoSynchronize(Method: TThreadMethod);// Conditional sync stub

{$ifdef SERIALIZE_RENDER}

    procedure PrefetchBitmap;		// Sync. bitmap prefetch

{$endif}

    procedure DoPaintFrame;		// Sync. buffered paint procedure

    procedure DoPaint;			// Sync. paint procedure

    procedure DoEvent;

    procedure SetActiveImage(const Value: integer);// Sync. event procedure

  protected

    procedure Execute; override;

    procedure SetAnimationSpeed(Value: integer);

  public

    constructor Create(AImage: TGIFImage; ACanvas: TCanvas; ARect: TRect;

      Options: TGIFDrawOptions);

    constructor CreateRef(Painter: PGIFPainter; AImage: TGIFImage; ACanvas: TCanvas; ARect: TRect;

      Options: TGIFDrawOptions);

    destructor Destroy; override;

    procedure Start;

    procedure Stop;

    procedure Restart;

    property Image: TGIFImage read FImage;

    property Canvas: TCanvas read FCanvas;

    property Rect: TRect read FRect write FRect;

    property DrawOptions: TGIFDrawOptions read FDrawOptions write FDrawOptions;

    property AnimationSpeed: integer read FAnimationSpeed write SetAnimationSpeed;

    property Started: boolean read FStarted;

    property ActiveImage: integer read FActiveImage write SetActiveImage;

    property OnStartPaint: TNotifyEvent read FOnStartPaint write FOnStartPaint;

    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;

    property OnAfterPaint: TNotifyEvent read FOnAfterPaint write FOnAfterPaint;

    property OnLoop: TNotifyEvent read FOnLoop write FOnLoop;

    property OnEndPaint	: TNotifyEvent read FOnEndPaint	 write FOnEndPaint	;

    property EventHandle: THandle read FEventHandle;

  end;



  TGIFWarning = procedure(Sender: TObject; Severity: TGIFSeverity; Message: string) of object;



  TGIFImage = class(TGraphic)

  private

    IsDrawing		: Boolean;

    IsInsideGetPalette	: boolean;

    FImages		: TGIFImageList;

    FHeader		: TGIFHeader;

    FGlobalPalette	: HPalette;

    FPainters		: TThreadList;

    FDrawOptions	: TGIFDrawOptions;

    FColorReduction	: TColorReduction;

    FReductionBits	: integer;

    FDitherMode		: TDitherMode;

    FCompression	: TGIFCompression;

    FOnWarning		: TGIFWarning;

    FBitmap		: TBitmap;

    FDrawPainter	: TGIFPainter;

    FThreadPriority	: TThreadPriority;

    FAnimationSpeed	: integer;

    FForceFrame: Integer;  // 2004.03.09

    FDrawBackgroundColor: TColor;

    FOnStartPaint	: TNotifyEvent;

    FOnPaint		: TNotifyEvent;

    FOnAfterPaint	: TNotifyEvent;

    FOnLoop		: TNotifyEvent;

    FOnEndPaint		: TNotifyEvent;

{$IFDEF VER9x}

    FPaletteModified	: Boolean;

    FOnProgress		: TProgressEvent;

{$ENDIF}

    function GetAnimate: Boolean;  // 2002.07.07

    procedure SetAnimate(const Value: Boolean);  // 2002.07.07

    procedure SetForceFrame(const Value: Integer);  // 2004.03.09

  protected

    // Obsolete: procedure Changed(Sender: TObject); {$IFDEF VER9x} virtual; {$ELSE} override; {$ENDIF}

    function GetHeight: Integer; override;

    procedure SetHeight(Value: Integer); override;

    function GetWidth: Integer; override;

    procedure SetWidth(Value: Integer); override;

    procedure AssignTo(Dest: TPersistent); override;

    function InternalPaint(Painter: PGIFPainter; ACanvas: TCanvas; const Rect: TRect; Options: TGIFDrawOptions): TGIFPainter;

    procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;

    function Equals(Graphic: TGraphic): Boolean; override;

    function GetPalette: HPALETTE; {$IFDEF VER9x} virtual; {$ELSE} override; {$ENDIF}

    procedure SetPalette(Value: HPalette); {$IFDEF VER9x} virtual; {$ELSE} override; {$ENDIF}

    function GetEmpty: Boolean; override;

    procedure WriteData(Stream: TStream); override;

    function GetIsTransparent: Boolean;

    function GetVersion: TGIFVersion;

    function GetColorResolution: integer;

    function GetBitsPerPixel: integer;

    function GetBackgroundColorIndex: BYTE;

    procedure SetBackgroundColorIndex(const Value: BYTE);

    function GetBackgroundColor: TColor;

    procedure SetBackgroundColor(const Value: TColor);

    function GetAspectRatio: BYTE;

    procedure SetAspectRatio(const Value: BYTE);

    procedure SetDrawOptions(Value: TGIFDrawOptions);

    procedure SetAnimationSpeed(Value: integer);

    procedure SetReductionBits(Value: integer);

    procedure NewImage;

    function GetBitmap: TBitmap;

    function NewBitmap: TBitmap;

    procedure FreeBitmap;

    function GetColorMap: TGIFColorMap;

    function GetDoDither: boolean;

    property DrawPainter: TGIFPainter read FDrawPainter; // Extremely volatile

    property DoDither: boolean read GetDoDither;

{$IFDEF VER9x}

    procedure Progress(Sender: TObject; Stage: TProgressStage;

      PercentDone: Byte;  RedrawNow: Boolean; const R: TRect; const Msg: string); dynamic;

{$ENDIF}

{$IFDEF FIXHEADER_WIDTHHEIGHT_SILENT}

    procedure FixHeaderWidthHeight;  // 2006.07.09

{$ENDIF}

  public

    constructor Create; override;

    destructor Destroy; override;

    procedure SaveToStream(Stream: TStream); override;

    procedure LoadFromStream(Stream: TStream); override;

    procedure LoadFromResourceName(Instance: THandle; const ResName: String);  // 2002.07.07

    function Add(Source: TPersistent): integer;

    procedure Pack;

    procedure OptimizeColorMap;

    procedure Optimize(Options: TGIFOptimizeOptions;

      ColorReduction: TColorReduction; DitherMode: TDitherMode;

      ReductionBits: integer);

    procedure Clear;

    procedure StopDraw;

    function Paint(ACanvas: TCanvas; const Rect: TRect; Options: TGIFDrawOptions): TGIFPainter;

    procedure PaintStart;

    procedure PaintPause;

    procedure PaintStop;

    procedure PaintResume;

    procedure PaintRestart;

    procedure Warning(Sender: TObject; Severity: TGIFSeverity; Message: string); virtual;

    procedure Assign(Source: TPersistent); override;

    procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;

      APalette: HPALETTE); override;

    procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;

      var APalette: HPALETTE); override;

    property GlobalColorMap: TGIFColorMap read GetColorMap;

    property Version: TGIFVersion read GetVersion;

    property Images: TGIFImageList read FImages;

    property ColorResolution: integer read GetColorResolution;

    property BitsPerPixel: integer read GetBitsPerPixel;

    property BackgroundColorIndex: BYTE read GetBackgroundColorIndex write SetBackgroundColorIndex;

    property BackgroundColor: TColor read GetBackgroundColor write SetBackgroundColor;

    property AspectRatio: BYTE read GetAspectRatio write SetAspectRatio;

    property Header: TGIFHeader read FHeader; // ***OBSOLETE***

    property IsTransparent: boolean read GetIsTransparent;

    property DrawOptions: TGIFDrawOptions read FDrawOptions write SetDrawOptions;

    property DrawBackgroundColor: TColor read FDrawBackgroundColor write FDrawBackgroundColor;

    property ColorReduction: TColorReduction read FColorReduction write FColorReduction;

    property ReductionBits: integer read FReductionBits write SetReductionBits;

    property DitherMode: TDitherMode read FDitherMode write FDitherMode;

    property Compression: TGIFCompression read FCompression write FCompression;

    property AnimationSpeed: integer read FAnimationSpeed write SetAnimationSpeed;

    property Animate: Boolean read GetAnimate write SetAnimate;  // 2002.07.07

    property ForceFrame: Integer read FForceFrame write SetForceFrame;  // 2004.03.09

    property Painters: TThreadList read FPainters;

    property ThreadPriority: TThreadPriority read FThreadPriority write FThreadPriority;

    property Bitmap: TBitmap read GetBitmap; // Volatile - beware!

    property OnWarning: TGIFWarning read FOnWarning write FOnWarning;

    property OnStartPaint: TNotifyEvent read FOnStartPaint write FOnStartPaint;

    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;

    property OnAfterPaint: TNotifyEvent read FOnAfterPaint write FOnAfterPaint;

    property OnLoop: TNotifyEvent read FOnLoop write FOnLoop;

    property OnEndPaint	: TNotifyEvent read FOnEndPaint	 write FOnEndPaint	;

{$IFDEF VER9x}

    property Palette: HPALETTE read GetPalette write SetPalette;

    property PaletteModified: Boolean read FPaletteModified write FPaletteModified;

    property OnProgress: TProgressEvent read FOnProgress write FOnProgress;

{$ENDIF}

  end;



////////////////////////////////////////////////////////////////////////////////

//

//                      Utility routines

//

////////////////////////////////////////////////////////////////////////////////

  // WebPalette creates a 216 color uniform palette a.k.a. the Netscape Palette

  function WebPalette: HPalette;



  // ReduceColors