?? gifimage.pas
字號:
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 char;
TGIFAuthenticationCode = array[0..2] of char;
TGIFApplicationRec = packed record
Identifier : TGIFIdentifierCode;
Authentication : TGIFAuthenticationCode;
end;
TGIFApplicationExtension = class;
TGIFAppExtensionClass = class of TGIFApplicationExtension;
TGIFApplicationExtension = class(TGIFExtension)
private
FIdent : TGIFApplicationRec;
function GetAuthentication: string;
function GetIdentifier: string;
protected
function GetExtensionType: TGIFExtensionType; override;
procedure SetAuthentication(const Value: string);
procedure SetIdentifier(const Value: string);
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: string read GetIdentifier write SetIdentifier;
property Authentication: string 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;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -