?? gifimage.pas
字號:
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;
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: PChar 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;
property Pixels[x, y: integer]: BYTE read GetPixel;
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 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
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -