gifimage.pas

用Delphi 开发的一个 户籍管理系统

    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}
  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
// Map colors in a bitmap to their nearest representation in a palette using
// the methods specified by the ColorReduction and DitherMode parameters.
// The ReductionBits parameter specifies the desired number of colors (bits
// per pixel) when the reduction method is rmQuantize. The CustomPalette
// specifies the palette when the rmPalette reduction method is used.
function ReduceColors(Bitmap: TBitmap; ColorReduction: TColorReduction;
  DitherMode: TDitherMode; ReductionBits: integer; CustomPalette: hPalette):
  TBitmap;

// CreateOptimizedPaletteFromManyBitmaps
//: Performs Color Quantization on multiple bitmaps.
// The Bitmaps parameter is a list of bitmaps. Returns an optimized palette.
function CreateOptimizedPaletteFromManyBitmaps(Bitmaps: TList; Colors,
  ColorBits: integer;
  Windows: boolean): hPalette;

{$IFDEF VER9x}
// From Delphi 3 graphics.pas
type
  TPixelFormat = (pfDevice, pf1bit, pf4bit, pf8bit, pf15bit, pf16bit, pf24bit,
    pf32bit, pfCustom);
{$ENDIF}

procedure InternalGetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: Integer;
  var ImageSize: longInt; PixelFormat: TPixelFormat);
function InternalGetDIB(Bitmap: HBITMAP; Palette: HPALETTE;
  var BitmapInfo; var Bits; PixelFormat: TPixelFormat): Boolean;

////////////////////////////////////////////////////////////////////////////////
//
//                      Global variables
//
////////////////////////////////////////////////////////////////////////////////
// GIF Clipboard format identifier for use by LoadFromClipboardFormat and
// SaveToClipboardFormat.
// Set in Initialization section.
var
  CF_GIF: WORD;

  ////////////////////////////////////////////////////////////////////////////////
  //
  //                      Library defaults
  //
  ////////////////////////////////////////////////////////////////////////////////
var
  //: Default options for TGIFImage.DrawOptions.
  GIFImageDefaultDrawOptions: TGIFDrawOptions =
  [goAsync, goLoop, goTransparent, goAnimate, goDither, goAutoDither
{$IFDEF STRICT_MOZILLA}
  , goClearOnLoop
{$ENDIF}
  ];

  // WARNING! Do not use goAsync and goDirectDraw unless you have absolute
  // control of the destination canvas.
  // TGIFPainter will continue to write on the canvas even after the canvas has
  // been deleted, unless *you* prevent it.
  // The goValidateCanvas option will fix this problem if it is ever implemented.

  //: Default color reduction methods for bitmap import.
  // These are the fastest settings, but also the ones that gives the
  // worst result (in most cases).
  GIFImageDefaultColorReduction: TColorReduction = rmNetscape;
  GIFImageDefaultColorReductionBits: integer = 8; // Range 3 - 8
  GIFImageDefaultDitherMode: TDitherMode = dmNearest;

  //: Default encoder compression method.
  GIFImageDefaultCompression: TGIFCompression = gcLZW;

  //: Default painter thread priority
  GIFImageDefaultThreadPriority: TThreadPriority = tpNormal;

  //: Default animation speed in % of normal speed (range 0 - 1000)
  GIFImageDefaultAnimationSpeed: integer = 100;

  // DoAutoDither is set to True in the initializaion section if the desktop DC
  // supports 256 colors or less.
  // It can be modified in your application to disable/enable Auto Dithering
  DoAutoDither: boolean = False;

  // Palette is set to True in the initialization section if the desktop DC
  // supports 256 colors or less.
  // You should NOT modify it.
  PaletteDevice: boolean = False;

  // Set GIFImageRenderOnLoad to True to render (convert to bitmap) the
  // GIF frames as they are loaded instead of rendering them on-demand.
  // This might increase resource consumption and will increase load time,
  // but will cause animated GIFs to display more smoothly.
  GIFImageRenderOnLoad: boolean = False;

  // If GIFImageOptimizeOnStream is true, the GIF will be optimized
  // before it is streamed to the DFM file.
  // This will not affect TGIFImage.SaveToStream or SaveToFile.
  GIFImageOptimizeOnStream: boolean = False;

  ////////////////////////////////////////////////////////////////////////////////
  //
  //                      Design Time support
  //
  ////////////////////////////////////////////////////////////////////////////////
  // Dummy component registration for design time support of GIFs in TImage
procedure Register;

////////////////////////////////////////////////////////////////////////////////
//
//                      Error messages
//
////////////////////////////////////////////////////////////////////////////////
{$IFNDEF VER9x}
resourcestring
{$ELSE}
const
{$ENDIF}
  // GIF Error messages
  sOutOfData = 'Premature end of data';
  sTooManyColors = 'Color table overflow';
  sBadColorIndex = 'Invalid color index';
  sBadVersion = 'Unsupported GIF version';
  sBadSignature = 'Invalid GIF signature';
  sScreenBadColorSize =
    'Invalid number of colors specified in Screen Descriptor';
  sImageBadColorSize = 'Invalid number of colors specified in Image Descriptor';
  sUnknownExtension = 'Unknown extension type';
  sBadExtensionLabel = 'Invalid extension introducer';
  sOutOfMemDIB = 'Failed to allocate memory for GIF DIB';
  sDIBCreate = 'Failed to create DIB from Bitmap';
  sDecodeTooFewBits = 'Decoder bit buffer under-run';
  sDecodeCircular = 'Circular decoder table entry';
  sBadTrailer = 'Invalid Image trailer';
  sBadExtensionInstance =
    'Internal error: Extension Instance does not match Extension Label';
  sBadBlockSize = 'Unsupported Application Extension block size';
  sBadBlock = 'Unknown GIF block type';
  sUnsupportedClass = 'Object type not supported for operation';
  sInvalidData = 'Invalid GIF data';
  sBadHeight = 'Image height too small for contained frames';
  sBadWidth = 'Image width too small for contained frames';
{$IFNDEF REGISTER_TGIFIMAGE}
  sGIFToClipboard = 'Clipboard operations not supported for GIF objects';
{$ELSE}
  sFailedPaste = 'Failed to store GIF on clipboard';
{$IFDEF VER9x}
  sUnknownClipboardFormat = 'Unsupported clipboard format';
{$ENDIF}
{$ENDIF}
  sScreenSizeExceeded = 'Image exceeds Logical Screen size';
  sNoColorTable = 'No global or local color table defined';
  sBadPixelCoordinates = 'Invalid pixel coordinates';
  sUnsupportedBitmap = 'Unsupported bitmap format';
  sInvalidPixelFormat = 'Unsupported PixelFormat';
  sBadDimension = 'Invalid image dimensions';
  sNoDIB = 'Image has no DIB';
  sInvalidStream = 'Invalid stream operation';
  sInvalidColor = 'Color not in color table';
  sInvalidBitSize = 'Invalid Bits Per Pixel value';
  sEmptyColorMap = 'Color table is empty';
  sEmptyImage = 'Image is empty';
  sInvalidBitmapList = 'Invalid bitmap list';
  sInvalidReduction = 'Invalid reduction method';
{$IFDEF VER9x}
  // From Delphi 3 consts.pas
  SOutOfResources = 'Out of system resources';
  SInvalidBitmap = 'Bitmap image is not valid';
  SScanLine = 'Scan line index out of range';
{$ENDIF}

  ////////////////////////////////////////////////////////////////////////////////
  //
  //                      Misc texts
  //
  ////////////////////////////////////////////////////////////////////////////////
    // File filter name
  sGIFImageFile = 'GIF Image';

  // Progress messages
  sProgressLoading = 'Loading...';
  sProgressSaving = 'Saving...';
  sProgressConverting = 'Converting...';
  sProgressRendering = 'Rendering...';
  sProgressCopying = 'Copying...';
  sProgressOptimizing = 'Optimizing...';

  ////////////////////////////////////////////////////////////////////////////////
  ////////////////////////////////////////////////////////////////////////////////
  //
  //			Implementation
  //
  ////////////////////////////////////////////////////////////////////////////////
  ////////////////////////////////////////////////////////////////////////////////
implementation

{ This makes me long for the C preprocessor... }
{$IFDEF DEBUG}
{$IFDEF DEBUG_COMPRESSPERFORMANCE}
{$DEFINE DEBUG_PERFORMANCE}
{$ELSE}
{$IFDEF DEBUG_DECOMPRESSPERFORMANCE}
{$DEFINE DEBUG_PERFORMANCE}
{$ELSE}
{$IFDEF DEBUG_DITHERPERFORMANCE}
{$DEFINE DEBUG_PERFORMANCE}
{$ELSE}
{$IFDEF DEBUG_DITHERPERFORMANCE}
{$DEFINE DEBUG_PERFORMANCE}
{$ELSE}
{$IFDEF DEBUG_DRAWPERFORMANCE}
{$DEFINE DEBUG_PERFORMANCE}
{$ELSE}
{$IFDEF DEBUG_RENDERPERFORMANCE}
{$DEFINE DEBUG_PERFORMANCE}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}

uses
{$IFDEF DEBUG}
  dialogs,
{$ENDIF}
  mmsystem, // timeGetTime()
  messages,
  Cons