网站公告列表

  没有公告
加入收藏
设为首页
联系站长
 | 网站首页 | 数据库教程 | web编程 | 服务器 | 程序设计 | 
您现在的位置： 网络学院 >> 程序设计 >> Delphi编程 >> 文章正文
  GDI+ 在Delphi程序的应用 -- 多帧（页）图像动画播放            【字体：小 大】
GDI+ 在Delphi程序的应用 -- 多帧（页）图像动画播放
作者：佚名    文章来源：不详    点击数：    更新时间：2007-8-3    

        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

       




本文来源：http://blog.csdn.net/maozefa/archive/2007/07/06/1680948.aspx