Starts implementing support for icon animations in TTrayIcon

git-svn-id: trunk@27581 -

lcl/extctrls.pp

@@ -1287,12 +1287,17 @@ type
 
   TCustomTrayIcon = class(TLCLComponent)
   private
+    FAnimate: Boolean;
+    FAnimateTimer: TTimer;
+    FCurAnimationStep: Integer;
     FBalloonFlags: TBalloonFlags;
     FBalloonHint: string;
     FBalloonTimeout: Integer;
     FBalloonTitle: string;
+    FIconList: TImageList;
     FPopUpMenu: TPopupMenu;
     FIcon: TIcon;
+    FIcons: TCustomImageList;
     FHint: string;
     FVisible, FShowIcon: Boolean;
     FNotifier: TPopupNotifier;
@@ -1300,13 +1305,18 @@ type
     FOnPaint, FOnClick, FOnDblClick: TNotifyEvent;
     FOnMouseDown, FOnMouseUp: TMouseEvent;
     FOnMouseMove: TMouseMoveEvent;
+    function GetAnimateInterval: Cardinal;
     function  GetCanvas: TCanvas;
+    procedure SetAnimate(const AValue: Boolean);
+    procedure SetAnimateInterval(const AValue: Cardinal);
     procedure SetHint(const AValue: string);
     procedure SetIcon(const AValue: TIcon);
+    procedure SetIcons(const AValue: TCustomImageList);
     procedure SetPopUpMenu(const AValue: TPopupMenu);
     procedure SetVisible(Value: Boolean);
     procedure HandleNotifierClose(Sender: TObject; var CloseAction: TCloseAction);
     procedure HandleNotifierTimeout(Sender: TObject);
+    procedure HandleOnAnimateTimer(Sender: TObject);
     procedure IconChanged(Sender: TObject);
   protected
     class procedure WSRegisterClass; override;
@@ -1321,6 +1331,8 @@ type
     procedure ShowBalloonHint;
     function GetPosition: TPoint;
     { Properties }
+    property Animate: Boolean read FAnimate write SetAnimate default False;
+    property AnimateInterval: Cardinal read GetAnimateInterval write SetAnimateInterval default 1000;
     property BalloonFlags: TBalloonFlags read FBalloonFlags write FBalloonFlags default bfNone;
     property BalloonHint: string read FBalloonHint write FBalloonHint;
     property BalloonTimeout: Integer read FBalloonTimeout write FBalloonTimeout default 3000;
@@ -1328,6 +1340,7 @@ type
     property Canvas: TCanvas read GetCanvas;
     property PopUpMenu: TPopupMenu read FPopUpMenu write SetPopUpMenu;
     property Icon: TIcon read FIcon write SetIcon;
+    property Icons: TCustomImageList read FIcons write SetIcons;
     property Hint: string read FHint write SetHint;
     property ShowIcon: Boolean read FShowIcon write FShowIcon default True;
     property Visible: Boolean read FVisible write SetVisible default False;

lcl/include/customtrayicon.inc

@@ -47,6 +47,12 @@ begin
   FIcon := TIcon.Create;
   FIcon.OnChange := @IconChanged;
 
+  // Animation objects
+  FIcons := TImageList.Create(Self);
+  FAnimateTimer := TTimer.Create(Self);
+  FAnimateTimer.Enabled := False;
+  FAnimateTimer.OnTimer := @HandleOnAnimateTimer;
+
   FNotifier := TPopupNotifier.Create(Self);
   FNotifier.OnClose := @HandleNotifierClose;
 
@@ -93,10 +99,13 @@ begin
 
   FVisible := False;
 
-  if not(csDesigning in ComponentState) then begin
+  if not(csDesigning in ComponentState) then
+  begin
     Result := TWSCustomTrayIconClass(WidgetSetClass).Hide(Self);
     FVisible := not Result;
-  end else
+    FAnimateTimer.Enabled := False;
+  end
+  else
     Result := false;
 end;
 
@@ -116,10 +125,13 @@ begin
 
   FVisible := True;
 
-  if not(csDesigning in ComponentState) then begin
+  if not(csDesigning in ComponentState) then
+  begin
     Result := TWSCustomTrayIconClass(WidgetSetClass).Show(Self);
     FVisible := Result;
-  end else
+    FAnimateTimer.Enabled := FAnimate;
+  end
+  else
     Result := false;
 end;
 
@@ -161,6 +173,20 @@ begin
   FNotifier.Hide;
 end;
 
+procedure TCustomTrayIcon.HandleOnAnimateTimer(Sender: TObject);
+var
+  lBitmap: TBitmap;
+begin
+  lBitmap := TBitmap.Create;
+  try
+    FIcons.GetBitmap(FCurAnimationStep, lBitmap);
+    FIcon.Assign(lBitmap);
+    InternalUpdate();
+  finally
+    lBitmap.Free;
+  end;
+end;
+
 procedure TCustomTrayIcon.IconChanged(Sender: TObject);
 begin
   if Handle <> 0 then
@@ -189,7 +215,10 @@ end;
 *
 *                  Currently only the following parameters use this:
 *
+*                  - Animate
 *                  - Hint
+*                  - Icon
+*                  - Icons
 *
 *                  For event parameters (PopUpMenu, OnMouseMove, etc)
 *                  this isn't necessary because they are handled
@@ -263,6 +292,27 @@ begin
   Result := TWSCustomTrayIconClass(WidgetSetClass).GetCanvas(Self);
 end;
 
+function TCustomTrayIcon.GetAnimateInterval: Cardinal;
+begin
+  Result := FAnimateTimer.Interval;
+end;
+
+procedure TCustomTrayIcon.SetAnimate(const AValue: Boolean);
+begin
+  if FAnimate=AValue then Exit;
+  FAnimate := AValue;
+  if Visible and AValue then
+    FAnimateTimer.Enabled := True
+  else
+    FAnimateTimer.Enabled := False;
+end;
+
+procedure TCustomTrayIcon.SetAnimateInterval(const AValue: Cardinal);
+begin
+  if FAnimateTimer.Interval=AValue then exit;
+  FAnimateTimer.Interval := AValue;
+end;
+
 procedure TCustomTrayIcon.SetHint(const AValue: string);
 begin
   FHint := AValue;
@@ -272,7 +322,16 @@ end;
 
 procedure TCustomTrayIcon.SetIcon(const AValue: TIcon);
 begin
+  if FIcon=AValue then Exit;
   FIcon.Assign(AValue);
+  if Visible then InternalUpdate();
+end;
+
+procedure TCustomTrayIcon.SetIcons(const AValue: TCustomImageList);
+begin
+  if FIcons=AValue then Exit;
+  FIcons.Assign(AValue);
+  if Visible then InternalUpdate();
 end;
 
 procedure TCustomTrayIcon.SetPopUpMenu(const AValue: TPopupMenu);