unit DxAnimateControl;

interface
uses
  Windows,SysUtils, Classes, Controls,Graphics,ImgList,ExtCtrls;

type
  TDxAnimateControl = class(TGraphicControl)
private
    FImageList: TImageList;
    Timer: TTimer;
    PicIndex: Integer;
    FActive: Boolean;
    bmp: TBitmap;
    FFrameSource: TBitmap;
    FFrameCount: Integer;
procedure SetImageList(const Value: TImageList);
procedure SetActive(const Value: Boolean);
function GetInterVal: Integer;
procedure SetInterVal(const Value: Integer);
procedure SetFrameSource(const Value: TBitmap);
procedure SetFrameCount(const Value: Integer);
protected
procedure DoTimer(Sender: TObject);
procedure DoPicChange(Sender: TObject);
procedure Paint;override;
public
constructor Create(AOwner: TComponent);override;
destructor Destroy;override;
published
property FrameSource: TBitmap read FFrameSource write SetFrameSource;
property FrameCount: Integer read FFrameCount write SetFrameCount default 1;
property ImageList: TImageList read FImageList write SetImageList;
property Interval: Integer read GetInterVal write SetInterVal;
property Active: Boolean read FActive write SetActive;
end;

procedure Register;
implementation

procedure Register;
begin
  RegisterComponents('Standard', [TDxAnimateControl]);
end;
{ TDxAnimateControl }

constructor TDxAnimateControl.Create(AOwner: TComponent);
begin
inherited;
  FFrameCount := 1;
  FFrameSource := TBitmap.Create;
  FFrameSource.OnChange := DoPicChange;
  bmp := TBitmap.Create;
  PicIndex := -1;
  Timer := TTimer.Create(self);
  FActive := False;
  Timer.Enabled := False;
  Timer.OnTimer := DoTimer;
  Width := 20;
  Height := 20;
end;

destructor TDxAnimateControl.Destroy;
begin
  bmp.Free;
  FFrameSource.Free;
inherited;
end;

procedure TDxAnimateControl.DoPicChange(Sender: TObject);
begin
if not FFrameSource.Empty then  
    Height := FFrameSource.Height;
  DoTimer(nil);
end;

procedure TDxAnimateControl.DoTimer(Sender: TObject);
var
  r: TRect;
  tmpw: Integer;
begin
if not FFrameSource.Empty then
begin
    tmpw := FFrameSource.Width div FFrameCount;
    bmp.Width := tmpw;
    bmp.Height := FFrameSource.Height;
    inc(PicIndex);
if PicIndex > FFrameCount - 1 then
      PicIndex := 0;
if PicIndex = FFrameCount - 1 then
      r := Rect(FFrameSource.Width - tmpw * (PicIndex - 1),0,FFrameSource.Width,FFrameSource.Height)
else
      r := Rect(PicIndex*tmpw,0,(PicIndex+1)*tmpw,FFrameSource.Height);
    bmp.Canvas.CopyRect(bmp.Canvas.ClipRect,FFrameSource.Canvas,r);
end
else
begin
    bmp.Canvas.Brush.Color := Color;
    bmp.Canvas.FillRect(ClientRect);
if (FImageList <> nil) and (FImageList.Count <> 0) then
begin
      inc(PicIndex);
if PicIndex > FImageList.Count - 1 then
        PicIndex := 0;
      FImageList.GetBitmap(PicIndex,Bmp);
end;
end;
  Invalidate;
end;

function TDxAnimateControl.GetInterVal: Integer;
begin
  Result := Timer.Interval;
end;

procedure TDxAnimateControl.Paint;
begin
if not bmp.Empty then
    Canvas.CopyRect(ClientRect,bmp.Canvas,bmp.Canvas.ClipRect)
else inherited;
end;

procedure TDxAnimateControl.SetActive(const Value: Boolean);
begin
if FActive <> Value then
begin
    FActive := Value;
if not (csDesigning in ComponentState) then
      Timer.Enabled := FActive;
if FActive or (csDesigning in ComponentState) then
      DoTimer(nil);
end;
end;

procedure TDxAnimateControl.SetFrameCount(const Value: Integer);
begin
if (FFrameCount <> value) and (Value > 0) then
begin
    FFrameCount := Value;
if not FFrameSource.Empty then
begin
      Width := FFrameSource.Width div FFrameCount;
      Invalidate;
end;
end;
end;

procedure TDxAnimateControl.SetFrameSource(const Value: TBitmap);
begin
  FFrameSource.Assign(Value);
end;

procedure TDxAnimateControl.SetImageList(const Value: TImageList);
begin
if FImageList <> Value then
begin
    FImageList := Value;
if FImageList <> nil then
begin
      Width := FImageList.Width;
      Height := FImageList.Height;
end;
    DoTimer(nil);
end;
end;

procedure TDxAnimateControl.SetInterVal(const Value: Integer);
begin
  Timer.Interval := Value;
end;

end.