gifimage.pas

基于DELPHI的图片浏览系统设计与实现

//{$IFNDEF VER9x}
//  {$IFNDEF VER10_PLUS}
//    {$DEFINE VER10_PLUS}
//    {$DEFINE VER11_PLUS}
//    {$DEFINE VER12_PLUS}
//    {$DEFINE BAD_STACK_ALIGNMENT}
//  {$ENDIF}
//{$ENDIF}
// 2003.03.09 <-

// 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 <-

////////////////////////////////////////////////////////////////////////////////
//
//		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 char;

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;