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( const Value:Integer);
procedureSetPlay( const Value:Boolean);
protected
procedureDoUpdateFrames; virtual ;
functionGetCanAnimate:Boolean; virtual ;
functionGetDefaultLoopCount:Integer; virtual ;
procedureSetDefaultDelays; virtual ;
procedureSetFrameCount( const Count: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;
if Assigned(FDelays)then
FreeMem(FDelays);
end;

procedureTImageAnimatBase.DoUpdateFrames;
begin
if Assigned(OnFrameChanged)then
OnFrameChanged(Self);
Inc(FFrameIndex);
if FrameIndex = 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;
for I: = 0 toFrameCount - 1 do
begin
P ^ : = 100 ;
Inc(P);
end;
end;

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

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

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

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

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

procedureTImageAnimatBase.UpdateFrames;
begin
if CanAnimatethen
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( const Value:TGpImage);
protected
procedureDoUpdateFrames; override ;
functionGetDefaultLoopCount:Integer; override ;
procedureSetDefaultDelays; override ;
public
propertyImage:TGpImagereadFImagewriteSetImage;
end;

implementation

usesGdipTypes;

... {TGpImageAnimator}

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

functionTGpImageAnimator.GetDefaultLoopCount:Integer;
var
Size:Integer;
Item:PPropertyItem;
begin
if notFDimensionTimethen
begin
Result: = inheritedGetDefaultLoopCount;
Exit;
end;
Size: = Image.GetPropertyItemSize(PropertyTagLoopCount);
GetMem(Item,Size);
try
Image.GetPropertyItem(PropertyTagLoopCount,Item);
Result: = Word(Item ^ .value ^ );
finally
FreeMem(Item,Size);
end;
end;

procedureTGpImageAnimator.SetDefaultDelays;
var
Size:Integer;
Item:PPropertyItem;
I:Integer;
P,Q:PLongWord;
begin
if notFDimensionTimethen
begin
inherited;
Exit;
end;
Size: = Image.GetPropertyItemSize(PropertyTagFrameDelay);
GetMem(Item,Size);
try
Image.GetPropertyItem(PropertyTagFrameDelay,Item);
P: = Delays;
Q: = PLongWord(Item ^ .value);
for I: = 0 toFrameCount - 1 do
begin
P ^ : = Q ^ * 10 ;
Inc(P);
Inc(Q);
end;
finally
FreeMem(Item,Size);
end;
end;

procedureTGpImageAnimator.SetFrameDimensionInfo;
var
Guids:arrayofTGUID;
I,Count:Integer;
begin
Count: = Image.FrameDimensionsCount;
SetLength(Guids,Count);
Image.GetFrameDimensionsList(@Guids[ 0 ],Count);
I: = 0 ;
while (I < Count)and(GUIDToString(Guids[I]) <> GUIDToString(FrameDimensionTime))and
(GUIDToString(Guids[I]) <> GUIDToString(FrameDimensionPage)) do
Inc(I);
if I = Countthen
raiseException.Create( ' ImagedoesnotcontainTimeorPageFrameDimensions. ' );
FGUID: = Guids[I];
FDimensionTime: = GUIDToString(FGUID) = GUIDToString(FrameDimensionTime);
SetFrameCount(Image.GetFrameCount(FGUID));
SetDefaultDelays;
LoopCount: = - 1 ;
end;

procedureTGpImageAnimator.SetImage( const Value:TGpImage);
begin
if (FImage <> Value)andnotPlaythen
begin
FImage: = Value;
if Assigned(FImage)then
SetFrameDimensionInfo
else
begin
FDimensionTime: = False;
SetFrameCount( 0 );
end;
end;
end;

end.

TGpImageAnimator重载了TImageAnimatBase的几个方法，添加了一个Image属性，下面就涉及GDI+图像操作的代码予以简单说明：

首先在SetFrameDimensionInfo中获取图像的帧维度及图像的帧（页）数，一般图像都只含一个维度，只有gif图像含基于时间的维度，也就是各帧图片的延时时间，其它则含页面维度：

Count := Image.FrameDimensionsCount;获取帧维度个数；

Image.GetFrameDimensionsList(@Guids[0], Count);获取图像所有帧维度的GUID，然后逐个比较是否包含时间维度或者页维度；

Image.GetFrameCount(FGUID);则获取图像包含的帧（页）数。

在SetDefaultDelays方法中，如果图像维度是基于时间的，如gif格式图像，用Image.GetPropertyItem(PropertyTagFrameDelay, Item)获取延时属性在Item，Item是TPropertyItem结构指针 ，其中的value是个长整型数组，包含各帧（页）图片的延时时间。

TPropertyItem = record
id: PROPID; // 属性的 ID
length: ULONG;// Value 的长度（以字节为单位）。
atype: WORD;// Value 的数据类型: PropertyTagTypeXXXX
value: Pointer; // 属性项的值
end;
PPropertyItem = ^TPropertyItem;

如果是页维度，则不包含PropertyTagFrameDelay，如tiff格式图像，只能自定义各页面的显示时间了。

同样，在GetDefaultLoopCount方法中，如果图像维度是基于时间的，通过Image.GetPropertyItem(PropertyTagLoopCount, Item)获取图像的循环次数。

下面是一段演示代码，在TPanel、TImage和TPaintBox组件上同步播放一张多帧gif图像。

procedureTMainForm.DrawImage(Handle:HWND;DC:HDC);
var
g:TGpGraphics;
begin
if Handle <> 0 then
g: = TGpGraphics.Create(Handle,False)
else
g: = TGpGraphics.Create(DC);
try
g.DrawImage(ImgAnimate.Image, 0 , 0 );
finally
g.Free;
end;
end;

procedureTMainForm.FormCreate(Sender:TObject);
begin
DoubleBuffered: = True;
ImgAnimate: = TGpImageAnimator.Create;
ImgAnimate.Image: = TGpImage.Create( ' ....Mediahbmap108.gif ' );
ImgAnimate.OnFrameChanged: = FrameChanged;
end;

procedureTMainForm.FormDestroy(Sender:TObject);
begin
ImgAnimate.Image.Free;
ImgAnimate.Free;
end;

procedureTMainForm.FrameChanged(Sender:TObject);
begin
DrawImage(Panel1.Handle, 0 );
DrawImage( 0 ,Image1.Canvas.Handle);
Image1.Invalidate;
PaintBox1.Invalidate;
end;

procedureTMainForm.PaintBox1Paint(Sender:TObject);
begin
DrawImage( 0 ,PaintBox1.Canvas.Handle);
end;

procedureTMainForm.PlayBtnClick(Sender:TObject);
begin
ImgAnimate.Play: = notImgAnimate.Play;
end;

procedureTMainForm.UpdateBtnClick(Sender:TObject);
begin
ImgAnimate.UpdateFrames;
end;

说明，本文所用GDI+代码与网上流通的不兼容，另外代码很长，没有进行严格测试，如有错误，请来信指正：maozefa@hotmail.com