unit DdhAnimB;

interface

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

{$R *.DCR}

type
  TDdhAniButton = class (TButton)
  private
    fImage: TPaintBox;
    fTimer: TTimer;
    fImageList: TImageList;
    fCurrImage: Integer;
    procedure OnTimer (Sender: TObject);

  protected
    // property access methods
    procedure SetImageList (Value: TImageList);
    procedure SetActive (Value: Boolean);
    function GetActive: Boolean;
    procedure SetInterval (Value: Integer);
    function GetInterval: Integer;

    // methods redefinition
    procedure SetBounds (ALeft, ATop,
      AWidth, AHeight: Integer); override;
    procedure MouseDown (Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp (Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer); override;
    procedure Mousemove (Shift: TShiftState;
      X, Y: Integer); override;

    // PaintBox event handlers
    procedure PaintBoxPaint (Sender: TObject);

  public
    constructor Create (AOwner: TComponent); override;

  published
    // image list property,
    // based on an external component
    property ImageList: TImageList
      read FImageList write SetImageList;
    // exported properties of the
    // internal timer component
    property Active: Boolean
      read GetActive write SetActive default False;
    property Interval: Integer
      read GetInterval write SetInterval default 500;
  end;

procedure Register;

implementation

constructor TDdhAniButton.Create (AOwner: TComponent);
begin
  inherited Create (AOwner);
  // create the paintbox
  fImage := TPaintBox.Create (self);
  fImage.Parent := self;
  fImage.Width := 16;
  fImage.Height := 16;
  {disable it, so that the button can handle
  its mouse messages direclty}
  fImage.Enabled := False;
  // custom paint event handler
  fImage.OnPaint := PaintBoxPaint;

  // create the timer
  fTimer := TTimer.Create (self);
  fTimer.OnTimer := OnTimer;
  fTimer.Enabled := False;
  fTimer.Interval := 500;
end;

procedure TDdhAniButton.SetBounds (
  ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds (ALeft, ATop, AWidth, AHeight);
  // center the paintbox, if exists
  if Assigned (fImage) then
  begin
    if Assigned (fImageList) then
      fImage.SetBounds (
        (Width - fImageList.Width) div 2,
        (Height - fImageList.Height) div 2,
        fImageList.Width, fImageList.Height)
    else
      fImage.SetBounds (
        Width div 2, Height div 2, 0, 0);
    fImage.Invalidate;
  end;
end;

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

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

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

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

procedure TDdhAniButton.SetImageList (Value: TImageList);
begin
  if fImageList <> Value then
  begin
    fImageList := Value;
    Caption := '';
    // change the position
    SetBounds (Left, Top, Width, Height);
  end;
end;

procedure TDdhAniButton.MouseDown (Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown (Button, Shift, X, Y);
  // update the image
  fImage.Invalidate;
end;

procedure TDdhAniButton.MouseUp (Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseUp (Button, Shift, X, Y);
  // update the image
  fImage.Invalidate;
end;

procedure TDdhAniButton.MouseMove (Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseMove (Shift, X, Y);
  // update the image only if dragging
  if MouseCapture then
    fImage.Invalidate;
end;

procedure TDdhAniButton.OnTimer (Sender: TObject);
begin
  if Assigned (fImageList) then
  begin
    // update counter and repaint
    Inc (fCurrImage);
    if fCurrImage >= fImageList.Count then
      fCurrImage := 0;
    fImage.Repaint;
  end;
end;

procedure TDdhAniButton.PaintBoxPaint (Sender: TObject);
begin
  // paintbox OnPaint event handler
  if Assigned (fImageList) then
    fImageList.Draw (fImage.Canvas, 0, 0, fCurrImage);
end;

procedure Register;
begin
  RegisterComponents ('DDHB', [TDdhAniButton]);
end;

end.