TAniImage

unit  AniImage ;
{* |<PRE>
================================================================================
* 软件名称：FHT GPS车辆监控管理系统
* 单元名称：AniImage
* 单元作者：HsuChong@hotmail.com
* 备    注：
* 开发平台：PWin2003Standard + Delphi 7.1
* 修改记录：2007.3.2 创建单元
================================================================================
|</PRE>}

interface

uses
   Windows ,  Messages ,  SysUtils ,  Classes ,  Controls ,  ExtCtrls ;

type
   TAniImage  =  class ( TImage )
   private
     fTimer :  TTimer ;
     fImageList :  TImageList ;
     fCurrImage :  Integer ;
     procedure  OnTimer ( Sender :  TObject );
   protected
     procedure  SetImageList ( Value :  TImageList );
     procedure  SetActive ( Value :  Boolean );
     function  GetActive :  Boolean ;
     procedure  SetInterval ( Value :  Integer );
     function  GetInterval :  Integer ;
   public
     constructor  Create ( AOwner :  TComponent );  override ;
   published

     property  ImageList :  TImageList  read  FImageList  write  SetImageList ;

     property  Active :  Boolean  read  GetActive  write  SetActive  default  False ;
     property  Interval :  Integer  read  GetInterval  write  SetInterval  default  500 ;
   end ;

procedure  Register ;

implementation

procedure  Register ;
begin
   RegisterComponents ( 'FHTGPS' ,  [ TAniImage ]);
end ;

constructor  TAniImage . Create ( AOwner :  TComponent );
begin
   inherited  Create ( AOwner );
   Self . Transparent  :=  True ;
   // create the timer
   fTimer  :=  TTimer . Create ( self );
   fTimer . OnTimer  :=  OnTimer ;
   fTimer . Enabled  :=  False ;
   fTimer . Interval  :=  500 ;
end ;

procedure  TAniImage . SetActive ( Value :  Boolean );
begin
   fTimer . Enabled  :=  Value ;
end ;

function  TAniImage . GetActive :  Boolean ;
begin
   Result  :=  fTimer . Enabled ;
end ;

procedure  TAniImage . SetInterval ( Value :  Integer );
begin
   fTimer . Interval  :=  Value ;
end ;

function  TAniImage . GetInterval :  Integer ;
begin
   Result  :=  fTimer . Interval ;
end ;

procedure  TAniImage . SetImageList ( Value :  TImageList );
begin
   if  fImageList  <>  Value  then
     fImageList  :=  Value ;
end ;

procedure  TAniImage . OnTimer ( Sender :  TObject );
begin
   if  Assigned ( fImageList )  then
   begin
     Self . Picture . Bitmap  :=  nil ;
     fImageList . GetBitmap ( fCurrImage ,  Self . Picture . Bitmap );
     Inc ( fCurrImage );
     if  fCurrImage  >=  fImageList . Count  then
       fCurrImage  :=  0 ;
   end ;
end ;

end .