unit DdhAnimC; interface uses Windows, Messages, SysUtils, Classes, Controls, StdCtrls, ExtCtrls; {$R *.DCR} type TDdhAniNotifButton = 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; procedure Notification(AComponent: TComponent; Operation: TOperation); 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 TDdhAniNotifButton.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 TDdhAniNotifButton.SetBounds ( ALeft, ATop, AWidth, AHeight: Integer); begin inherited SetBounds (ALeft, ATop, AWidth, AHeight); // center the paintbox, if it 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 TDdhAniNotifButton.SetActive (Value: Boolean); begin fTimer.Enabled := Value; end; function TDdhAniNotifButton.GetActive: Boolean; begin Result := fTimer.Enabled; end; procedure TDdhAniNotifButton.SetInterval (Value: Integer); begin fTimer.Interval := Value; end; function TDdhAniNotifButton.GetInterval: Integer; begin Result := fTimer.Interval; end; procedure TDdhAniNotifButton.SetImageList (Value: TImageList); begin if fImageList <> Value then begin fImageList := Value; Caption := ''; // change the position SetBounds (Left, Top, Width, Height); end; end; procedure TDdhAniNotifButton.Notification( AComponent: TComponent; Operation: TOperation); begin if (Operation = opRemove) and (AComponent = fImageList) then SetImageList (nil); end; procedure TDdhAniNotifButton.MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseDown (Button, Shift, X, Y); // update the image fImage.Invalidate; end; procedure TDdhAniNotifButton.MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseUp (Button, Shift, X, Y); // update the image fImage.Invalidate; end; procedure TDdhAniNotifButton.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 TDdhAniNotifButton.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 TDdhAniNotifButton.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', [TDdhAniNotifButton]); end; end.