diff --git a/lcl/extctrls.pp b/lcl/extctrls.pp index 25aa0c79bd..6d9b1c227b 100644 --- a/lcl/extctrls.pp +++ b/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; diff --git a/lcl/include/customtrayicon.inc b/lcl/include/customtrayicon.inc index 0b8c953e84..a4957332d0 100644 --- a/lcl/include/customtrayicon.inc +++ b/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);