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

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

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

 

unit ImageAnimateBase;

... {***********************************************************}
... {                                                           }
... { TImageAnimatBase                                      }
... {     控制多帧图像动画显示，该类是一个基类                  }
... {                                                           }
... { 方法：                                                    }
... { procedure SetDelays(ADelays: array of LongWord);          }
... {   设置各帧图像显示之间的延时时间。时间单位为毫秒          }
... {   ADelays数组各元素表示各帧图像的延时时间，如元素个数小于 }
... { 图像帧数，其余图像延时时间设置为ADelays最后一个元素的值， }
... { 因此，如果需要所有图像同样的延时时间，可以这样设置：      }
... {   SetDelays([100]);                                       }
... { 元素个数大于图像帧数，多余的忽略；元素个数为0，则设置为缺 }
... { 省延时时间100，派生类可重载函数SetDefaultDelays改变缺省值 }
... {                                                           }
... { procedure UpdateFrames;                                   }
... {   进入下一帧，更新图像在下次显示出来。该过程在Play=False  }
... { 时也能更新显示图像显示，且不受LoopCount限制               }
... {                                                           }
... { 属性：                                                    }
... { property CanAnimate: Boolean;                             }
... {   只读，判断是否可动画播放。派生类可重载SetCanAnimate过程 }
... {                                                           }
... { property FrameCount: Integer;                             }
... {   只读，返回图像帧数                                      }
... {                                                           }
... { property FrameIndex: Integer;                             }
... {   只读，返回当前帧的索引号                                }
... {                                                           }
... { property LoopCount: Integer;                              }
... {   动画播放循环次数。值为0无限循环，如果设置值小于0，则取  }
... { 缺省值0，可重载GetDefaultLoopCount函数改变缺省值          }
... {                                                           }
... { property Play: Boolean;                                   }
... {   播放和停止动画显示。每次播放时，帧索引和循环次数复位    }
... {                                                           }
... { 事件：                                                    }
... { property OnFrameChanged: 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;
    procedure TimerOnTimer(Sender: TObject);
    function GetPlay: Boolean;
    procedure SetLoopCount( const  Value: Integer);
    procedure SetPlay( const  Value: Boolean);
   protected
    procedure DoUpdateFrames;  virtual ;
    function GetCanAnimate: Boolean;  virtual ;
    function GetDefaultLoopCount: Integer;  virtual ;
    procedure SetDefaultDelays;  virtual ;
    procedure SetFrameCount( const  Count: Integer);

    property Delays: PLongWord read FDelays;
   public
    constructor Create;
    destructor Destroy;  override ;
    procedure SetDelays(ADelays: array of LongWord);
    procedure UpdateFrames;

    property CanAnimate: Boolean read GetCanAnimate;
    property FrameCount: Integer read FFrameCount;
    property FrameIndex: Integer read FFrameIndex;
    property LoopCount: Integer read FLoopCount write SetLoopCount;
    property Play: Boolean read GetPlay write SetPlay;
    property OnFrameChanged: TNotifyEvent read FOnFrameChanged write FOnFrameChanged;
  end;

implementation

... { TImageAnimatBase }

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

destructor TImageAnimatBase.Destroy;
begin
  FTimer.Free;
   if  Assigned(FDelays) then
    FreeMem(FDelays);
end;

procedure TImageAnimatBase.DoUpdateFrames;
begin
   if  Assigned(OnFrameChanged) then
    OnFrameChanged(Self);
  Inc(FFrameIndex);
   if  FrameIndex  =  FrameCount then
  begin
    FFrameIndex : =   0 ;
     if  (LoopCount  <>   0 ) and (FLoopIndex  <  LoopCount) then
      Inc(FLoopIndex);
  end;
end;

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

function TImageAnimatBase.GetDefaultLoopCount: Integer;
begin
  Result : =   0 ;
end;

function TImageAnimatBase.GetPlay: Boolean;
begin
  Result : =  FTimer.Enabled;
end;

procedure TImageAnimatBase.SetDefaultDelays;
var
  I: Integer;
  P: PLongWord;
begin

    if not CanAnimate then Exit;
  P : =  FDelays;
   for  I : =   0  to FrameCount  -   1   do
  begin
    P ^  : =   100 ;
    Inc(P);
  end;
end;

procedure TImageAnimatBase.SetDelays(ADelays: array of LongWord);
var
  I, Count: Integer;
  P: PLongWord;
begin
   if  not CanAnimate then Exit;
  Count : =  Length(ADelays);
   if  Count  =   0  then
  begin
    SetDefaultDelays;
    Exit;
  end;
  P : =  FDelays;
   for  I : =   0  to FrameCount  -   1   do
  begin
     if  I  <  Count then
      P ^  : =  ADelays[I]
     else
      P ^  : =  ADelays[Count  -   1 ];
    Inc(P);
  end;
end;

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

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

procedure TImageAnimatBase.SetPlay( const  Value: Boolean);
begin
   if  (Play  <>  Value) and (not Value or CanAnimate) then
  begin
     if  Value then
    begin
      FFrameIndex : =   0 ;
      FLoopIndex : =   0 ;
    end;
    FTimer.Enabled : =  Value;
  end;
end;

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

procedure TImageAnimatBase.UpdateFrames;
begin
   if  CanAnimate then
    DoUpdateFrames;
end;

end.

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

unit GpImageAnimate;

interface

uses
  SysUtils, ActiveX, Gdiplus, ImageAnimateBase;

type
  TGpImageAnimator  =   class (TImageAnimatBase)
   private
    FImage: TGpImage;
    FGUID: TGUID;
    FDimensionTime: Boolean;
    procedure SetFrameDimensionInfo;
    procedure SetImage( const  Value: TGpImage);
   protected
    procedure DoUpdateFrames;  override ;
    function GetDefaultLoopCount: Integer;  override ;
    procedure SetDefaultDelays;  override ;
   public
    property Image: TGpImage read FImage write SetImage;
  end;
  
implementation

uses GdipTypes;

... { TGpImageAnimator }

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

function TGpImageAnimator.GetDefaultLoopCount: Integer;
var
  Size: Integer;
  Item: PPropertyItem;
begin
   if  not FDimensionTime then
  begin
    Result : =  inherited GetDefaultLoopCount;
    Exit;
  end;
  Size : =  Image.GetPropertyItemSize(PropertyTagLoopCount);
  GetMem(Item, Size);
   try
    Image.GetPropertyItem(PropertyTagLoopCount, Item);
    Result : =  Word(Item ^ .value ^ );
   finally
    FreeMem(Item, Size);
  end;
end;

procedure TGpImageAnimator.SetDefaultDelays;
var
  Size: Integer;
  Item: PPropertyItem;
  I: Integer;
  P, Q: PLongWord;
begin
   if  not FDimensionTime then
  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  to FrameCount  -   1   do
    begin
      P ^  : =  Q ^   *   10 ;
      Inc(P);
      Inc(Q);
    end;
   finally
    FreeMem(Item, Size);
  end;
end;

procedure TGpImageAnimator.SetFrameDimensionInfo;
var
  Guids: array of TGUID;
  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  =  Count then
    raise Exception.Create( ' Image does not contain Time or Page Frame Dimensions. ' );
  FGUID : =  Guids[I];
  FDimensionTime : =  GUIDToString(FGUID)  =  GUIDToString(FrameDimensionTime);
  SetFrameCount(Image.GetFrameCount(FGUID));
  SetDefaultDelays;
  LoopCount : =   - 1 ;
end;

procedure TGpImageAnimator.SetImage( const  Value: TGpImage);
begin
   if  (FImage  <>  Value) and not Play then
  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图像。

 

procedure TMainForm.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;

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

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

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

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

procedure TMainForm.PlayBtnClick(Sender: TObject);
begin
  ImgAnimate.Play : =  not ImgAnimate.Play;
end;

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

       

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