GDI+ 在Delphi程序的应用 -- 多帧（页）图像动画播放

GDI+支持多种图像格式的操作，其中的gif和tiff格式图像可包含多帧（页）图片，在一般的显示中，只能显示图像的第一帧（页）图片。.NET专门有个ImageAnimator类，用来播放此类图像，在Delphi中，我们也可利用GDI+编制自己的多帧（页）图像动画播放类。

笔者写了一个多帧（页）图像动画播放类，为了代码重用，先写了一个基类TImageAnimatBase，下面是该类的源码，类的主要方法和属性已经在源码中说明：

unitImageAnimateBase;

...{***********************************************************}
...{}
...{TImageAnimatBase}
...{控制多帧图像动画显示，该类是一个基类}
...{}
...{方法：}
...{procedureSetDelays(ADelays:arrayofLongWord);}
...{设置各帧图像显示之间的延时时间。时间单位为毫秒}
...{ADelays数组各元素表示各帧图像的延时时间，如元素个数小于}
...{图像帧数，其余图像延时时间设置为ADelays最后一个元素的值，}
...{因此，如果需要所有图像同样的延时时间，可以这样设置：}
...{SetDelays([100]);}
...{元素个数大于图像帧数，多余的忽略；元素个数为0，则设置为缺}
...{省延时时间100，派生类可重载函数SetDefaultDelays改变缺省值}
...{}
...{procedureUpdateFrames;}
...{进入下一帧，更新图像在下次显示出来。该过程在Play=False}
...{时也能更新显示图像显示，且不受LoopCount限制}
...{}
...{属性：}
...{propertyCanAnimate:Boolean;}
...{只读，判断是否可动画播放。派生类可重载SetCanAnimate过程}
...{}
...{propertyFrameCount:Integer;}
...{只读，返回图像帧数}
...{}
...{propertyFrameIndex:Integer;}
...{只读，返回当前帧的索引号}
...{}
...{propertyLoopCount:Integer;}
...{动画播放循环次数。值为0无限循环，如果设置值小于0，则取}
...{缺省值0，可重载GetDefaultLoopCount函数改变缺省值}
...{}
...{propertyPlay:Boolean;}
...{播放和停止动画显示。每次播放时，帧索引和循环次数复位}
...{}
...{事件：}
...{propertyOnFrameChanged:TNotifyEvent;}
...{图像帧改变。必须响应该事件处理图像显示}
...{}
...{***********************************************************}

interface

uses
SysUtils,Classes,ExtCtrls;

type
TImageAnimatBase=class(TObject)
private
FTimer:TTimer;
FDelays:PLongWord;
FLoopCount:Integer;
FLoopIndex:Integer;
FFrameCount:Integer;
FFrameIndex:Integer;
FOnFrameChanged:TNotifyEvent;
procedureTimerOnTimer(Sender:TObject);
functionGetPlay:Boolean;
procedureSetLoopCount(constValue:Integer);
procedureSetPlay(constValue:Boolean);
protected
procedureDoUpdateFrames;virtual;
functionGetCanAnimate:Boolean;virtual;
functionGetDefaultLoopCount:Integer;virtual;
procedureSetDefaultDelays;virtual;
procedureSetFrameCount(constCount:Integer);

propertyDelays:PLongWordreadFDelays;
public
constructorCreate;
destructorDestroy;override;
procedureSetDelays(ADelays:arrayofLongWord);
procedureUpdateFrames;

propertyCanAnimate:BooleanreadGetCanAnimate;
propertyFrameCount:IntegerreadFFrameCount;
propertyFrameIndex:IntegerreadFFrameIndex;
propertyLoopCount:IntegerreadFLoopCountwriteSetLoopCount;
propertyPlay:BooleanreadGetPlaywriteSetPlay;
propertyOnFrameChanged:TNotifyEventreadFOnFrameChangedwriteFOnFrameChanged;
end;

implementation

...{TImageAnimatBase}

constructorTImageAnimatBase.Create;
begin
FTimer:=TTimer.Create(nil);
FTimer.Enabled:=False;
FTimer.Interval:=100;
FTimer.OnTimer:=TimerOnTimer;
end;

destructorTImageAnimatBase.Destroy;
begin
FTimer.Free;
ifAssigned(FDelays)then
FreeMem(FDelays);
end;

procedureTImageAnimatBase.DoUpdateFrames;
begin
ifAssigned(OnFrameChanged)then
OnFrameChanged(Self);
Inc(FFrameIndex);
ifFrameIndex=FrameCountthen
begin
FFrameIndex:=0;
if(LoopCount<>0)and(FLoopIndex<LoopCount)then
Inc(FLoopIndex);
end;
end;

functionTImageAnimatBase.GetCanAnimate:Boolean;
begin
Result:=FrameCount>1;
end;

functionTImageAnimatBase.GetDefaultLoopCount:Integer;
begin
Result:=0;
end;

functionTImageAnimatBase.GetPlay:Boolean;
begin
Result:=FTimer.Enabled;
end;

procedureTImageAnimatBase.SetDefaultDelays;
var
I:Integer;
P:PLongWord;
begin

if not CanAnimate then Exit;
P:=FDelays;
forI:=0toFrameCount-1do
begin
P^:=100;
Inc(P);
end;
end;

procedureTImageAnimatBase.SetDelays(ADelays:arrayofLongWord);
var
I,Count:Integer;
P:PLongWord;
begin
ifnotCanAnimatethenExit;
Count:=Length(ADelays);
ifCount=0then
begin
SetDefaultDelays;
Exit;
end;
P:=FDelays;
forI:=0toFrameCount-1do
begin
ifI<Countthen
P^:=ADelays[I]
else
P^:=ADelays[Count-1];
Inc(P);
end;
end;

procedureTImageAnimatBase.SetFrameCount(constCount:Integer);
begin
ifFFrameCount<>Countthen
begin
ifAssigned(FDelays)then
begin
FreeMem(FDelays);
FDelays:=nil;
end;
FFrameCount:=Count;
ifFFrameCount>1then
GetMem(FDelays,FFrameCount*Sizeof(LongWord));
end;
end;

procedureTImageAnimatBase.SetLoopCount(constValue:Integer);
begin
ifFLoopCount<>Valuethen
ifValue<0then
FLoopCount:=GetDefaultLoopCount
else
FLoopCount:=Value;
end;

procedureTImageAnimatBase.SetPlay(constValue:Boolean);
begin
if(Play<>Value)and(notValueorCanAnimate)then
begin
ifValuethen
begin
FFrameIndex:=0;
FLoopIndex:=0;
end;
FTimer.Enabled:=Value;
end;
end;

procedureTImageAnimatBase.TimerOnTimer(Sender:TObject);
var
P:PLongWord;
begin
P:=FDelays;
Inc(P,FrameIndex);
ifP^<>FTimer.Intervalthen
FTimer.Interval:=P^;
DoUpdateFrames;
if(FLoopCount<>0)and(FLoopIndex=LoopCount)then
Play:=False;
end;

procedureTImageAnimatBase.UpdateFrames;
begin
ifCanAnimatethen
DoUpdateFrames;
end;

end.

下面是基于GDI+的TImageAnimatBase派生类TGpImageAnimator源码：

unitGpImageAnimate;

interface

uses
SysUtils,ActiveX,Gdiplus,ImageAnimateBase;

type
TGpImageAnimator=class(TImageAnimatBase)
private
FImage:TGpImage;
FGUID:TGUID;
FDimensionTime:Boolean;
procedureSetFrameDimensionInfo;
procedureSetImage(constValue:TGpImage);
protected
procedureDoUpdateFrames;override;
functionGetDefaultLoopCount:Integer;override;
procedureSetDefaultDelays;override;
public
propertyImage:TGpImagereadFImagewriteSetImage;
end;

implementation

usesGdipTypes;

...{TGpImageAnimator}

procedureTGpImageAnimator.DoUpdateFrames;
begin
Image.SelectActiveFrame(FGUID,FrameIndex);