学步园

        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;