Class TGIFImage (unit GIFImage)

Inherits from

TGraphic

Constructors


constructor Create;



Functions

function Add(Source: TPersistent): integer;


procedure Assign(Source: TPersistent);


procedure Clear;


destructor Destroy;


procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle; APalette: HPALETTE);


procedure LoadFromStream(Stream: TStream);

Write trailer

procedure Pack;

Zap all bitmaps

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

This shouldn't be nescesarry since the thread is deleted on exit from Execute, but better safe than sorry.

procedure PaintPause;

Process Messages to make TThread.

procedure PaintResume;


procedure PaintStart;

Run in separate thread

procedure PaintStop;


procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle; var APalette: HPALETTE);

No GIF on clipboard - try loading a bitmap instead

procedure SaveToStream(Stream: TStream);

Zap local colormap

procedure StopDraw;


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


procedure AssignTo(Dest: TPersistent);


procedure Changed(Sender: TObject);

Need to create new bitmap and repaint

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

Process Messages to make Synchronize work (Instead of Application.

function Equals(Graphic: TGraphic): Boolean;


procedure FreeBitmap;

Draw first image on bitmap

function GetBackgroundColor: TColor;


function GetBackgroundColorIndex: BYTE;


function GetBitmap: TBitmap;

Read trailer

function GetBitsPerPixel: integer;


function GetColorMap: TGIFColorMap;

Put it all on the clipboard

function GetColorResolution: integer;


function GetDoDither: boolean;


function GetEmpty: Boolean;

Set width & height if added image is larger than existing images

function GetHeight: Integer;


function GetPalette: HPALETTE;


function GetVersion: TGIFVersion;


function GetWidth: Integer;


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

Internal pain(t) routine used by Draw(

function NewBitmap: TBitmap;

Create a new (empty) bitmap

procedure NewImage;


procedure SetDrawOptions(Value: TGIFDrawOptions);


procedure SetHeight(Value: Integer);


procedure SetPalette(Value: HPalette);

This can cause a recursion if no global palette exist and image[0] hasn't got one either.

procedure SetWidth(Value: Integer);


Properties

property BackgroundColor : TColor


property BackgroundColorIndex : BYTE


property Bitmap : TBitmap


property BitsPerPixel : integer


property ColorResolution : integer


property DrawBackgroundColor : TColor


property DrawOptions : TGIFDrawOptions


property GlobalColorMap : TGIFColorMap


property Header : TGIFHeader


property Images : TGIFImageList


property Painters : TThreadList


property ThreadPriority : TThreadPriority


property Version : TGIFVersion


property DoDither : boolean

Extremely volatile

property DrawPainter : TGIFPainter


Events

event OnEndPaint : TNotifyEvent


event OnLoop : TNotifyEvent


event OnPaint : TNotifyEvent


event OnStartPaint : TNotifyEvent

Volatile - beware!

event OnWarning : TGIFWarning


Variables

FBitmap : TBitmap;


FDrawBackgroundColor : TColor;


FDrawOptions : TGIFDrawOptions;


FDrawPainter : TGIFPainter;


FGlobalPalette : HPalette;


FHeader : TGIFHeader;


FImages : TGIFImageList;


FOnEndPaint : TNotifyEvent;


FOnLoop : TNotifyEvent;


FOnPaint : TNotifyEvent;


FOnStartPaint : TNotifyEvent;


FOnWarning : TGIFWarning;


FPainters : TThreadList;


FThreadPriority : TThreadPriority;


IsDrawing : Boolean;


IsInsideGetPalette : boolean;



Constructors


constructor Create;


Functions


function Add(Source: TPersistent): integer;


procedure Assign(Source: TPersistent);


procedure Clear;


destructor Destroy;


procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle; APalette: HPALETTE);


procedure LoadFromStream(Stream: TStream);

Write trailer


procedure Pack;

Zap all bitmaps


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

This shouldn't be nescesarry since the thread is deleted on exit from Execute, but better safe than sorry...


procedure PaintPause;

Process Messages to make TThread.Synchronize work (Instead of Application.ProcessMessages


procedure PaintResume;


procedure PaintStart;

Run in separate thread


procedure PaintStop;


procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle; var APalette: HPALETTE);

No GIF on clipboard - try loading a bitmap instead


procedure SaveToStream(Stream: TStream);

Zap local colormap


procedure StopDraw;


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


procedure AssignTo(Dest: TPersistent);


procedure Changed(Sender: TObject);

Need to create new bitmap and repaint


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

Process Messages to make Synchronize work (Instead of Application.ProcessMessages


function Equals(Graphic: TGraphic): Boolean;


procedure FreeBitmap;

Draw first image on bitmap


function GetBackgroundColor: TColor;


function GetBackgroundColorIndex: BYTE;


function GetBitmap: TBitmap;

Read trailer


function GetBitsPerPixel: integer;


function GetColorMap: TGIFColorMap;

Put it all on the clipboard


function GetColorResolution: integer;


function GetDoDither: boolean;


function GetEmpty: Boolean;

Set width & height if added image is larger than existing images


function GetHeight: Integer;


function GetPalette: HPALETTE;


function GetVersion: TGIFVersion;


function GetWidth: Integer;


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

Internal pain(t) routine used by Draw(


function NewBitmap: TBitmap;

Create a new (empty) bitmap


procedure NewImage;


procedure SetDrawOptions(Value: TGIFDrawOptions);


procedure SetHeight(Value: Integer);


procedure SetPalette(Value: HPalette);

This can cause a recursion if no global palette exist and image[0] hasn't got one either. Checked by the IsInsideGetPalette semaphor.


procedure SetWidth(Value: Integer);


Properties


property BackgroundColor : TColor


property BackgroundColorIndex : BYTE


property Bitmap : TBitmap


property BitsPerPixel : integer


property ColorResolution : integer


property DrawBackgroundColor : TColor


property DrawOptions : TGIFDrawOptions


property GlobalColorMap : TGIFColorMap


property Header : TGIFHeader


property Images : TGIFImageList


property Painters : TThreadList


property ThreadPriority : TThreadPriority


property Version : TGIFVersion


property DoDither : boolean

Extremely volatile


property DrawPainter : TGIFPainter


Events


event OnEndPaint : TNotifyEvent


event OnLoop : TNotifyEvent


event OnPaint : TNotifyEvent


event OnStartPaint : TNotifyEvent

Volatile - beware!


event OnWarning : TGIFWarning


Variables


FBitmap : TBitmap;


FDrawBackgroundColor : TColor;


FDrawOptions : TGIFDrawOptions;


FDrawPainter : TGIFPainter;


FGlobalPalette : HPalette;


FHeader : TGIFHeader;


FImages : TGIFImageList;


FOnEndPaint : TNotifyEvent;


FOnLoop : TNotifyEvent;


FOnPaint : TNotifyEvent;


FOnStartPaint : TNotifyEvent;


FOnWarning : TGIFWarning;


FPainters : TThreadList;


FThreadPriority : TThreadPriority;


IsDrawing : Boolean;


IsInsideGetPalette : boolean;