[JVCL-Checkins] CVS: jvcl/source JvTrayIcon.pas,1.20,1.21

[Peter T. <pe...@us...>]

Update of /cvsroot/jvcl/jvcl/source
In directory sc8-pr-cvs1:/tmp/cvs-serv19301/source

Modified Files:
	JvTrayIcon.pas 
Log Message:
-Balloonhint updates from Olivier Sannier (Mantis #906)

Index: JvTrayIcon.pas
===================================================================
RCS file: /cvsroot/jvcl/jvcl/source/JvTrayIcon.pas,v
retrieving revision 1.20
retrieving revision 1.21
diff -C2 -d -r1.20 -r1.21
*** JvTrayIcon.pas	1 Mar 2003 01:08:24 -0000	1.20
--- JvTrayIcon.pas	28 May 2003 22:24:25 -0000	1.21
***************
*** 71,74 ****
--- 71,75 ----
      FHandle: THandle;
      FHint: string;
+     FBalloonCloser : TTimer;
      FPopupMenu: TPopupMenu;
      FOnClick: TMouseEvent;
***************
*** 90,93 ****
--- 91,95 ----
      FOnBalloonShow: TNotifyEvent;
      FOnBalloonClick: TNotifyEvent;
+     FOnHint : TNotifyEvent;
      FTime: TDateTime;
      FTimeDelay: Integer;
***************
*** 98,102 ****
--- 100,107 ----
      FSnap: Boolean;
      FHooked: Boolean;
+ 
+     function  GetSystemMinimumBalloonDelay : integer;
      procedure OnAnimateTimer(Sender: TObject);
+     procedure OnBalloonCloserTimer(Sender: TObject);
      procedure IconChanged(Sender: TObject);
      procedure SetActive(Value: Boolean);
***************
*** 128,132 ****
      procedure ShowApplication;
      procedure BalloonHint(Title, Value: string; BalloonType:
!       TBalloonType = btNone; Delay: Integer = 5000);
      function AcceptBalloons: Boolean;
    published
--- 133,137 ----
      procedure ShowApplication;
      procedure BalloonHint(Title, Value: string; BalloonType:
!       TBalloonType = btNone; Delay: Integer = 5000; CancelPrevious :boolean=false);
      function AcceptBalloons: Boolean;
    published
***************
*** 154,157 ****
--- 159,163 ----
      property OnBalloonHide: TNotifyEvent read FOnBalloonHide write FOnBalloonHide;
      property OnBalloonClick: TNotifyEvent read FOnBalloonClick write FOnBalloonClick;
+     property OnHint : TNotifyEvent read FOnHint write FOnHint;
    end;
  
***************
*** 220,223 ****
--- 226,233 ----
    FTask := True;
  
+   FBalloonCloser := TTimer.Create(self);
+   FBalloonCloser.Enabled := false;
+   FBalloonCloser.OnTimer := OnBalloonCloserTimer;
+ 
    if not (csDesigning in ComponentState) then
    begin
***************
*** 238,241 ****
--- 248,253 ----
    FTimer.Free;
    SetActive(False);
+   FBalloonCloser.Enabled := false;
+   FBalloonCloser.Free;
    FIcon.Free;
    {$IFDEF COMPILER6_UP}
***************
*** 511,516 ****
  end;
  
  procedure TJvTrayIcon.BalloonHint(Title, Value: string;
!   BalloonType: TBalloonType; Delay: Integer);
  //http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/Shell/reference/functions/shell_notifyicon.asp
  begin
--- 523,548 ----
  end;
  
+ function TJvTrayIcon.GetSystemMinimumBalloonDelay: integer;
+ begin
+   // from Microsoft's documentation, a balloon is shown for at
+   // least 10 seconds, but it is a system settings which must
+   // be somewhere in the registry. The only question is : Where ?
+   Result := 10000;
+ end;
+ 
+ procedure TjvTrayIcon.OnBalloonCloserTimer(Sender: TObject);
+ begin
+   // we stop the timer
+   FBalloonCloser.Enabled := false;
+   // then we call BalloonHint with title and info set to
+   // empty strings which surprisingly will cancel any existing
+   // balloon for the icon. This is clearly not documented by
+   // microsoft and may not work in later releases of Windows
+   // it has been tested on XP Home French
+   BalloonHint('','');
+ end;
+ 
  procedure TJvTrayIcon.BalloonHint(Title, Value: string;
!   BalloonType: TBalloonType; Delay: Integer; CancelPrevious : boolean);
  //http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/Shell/reference/functions/shell_notifyicon.asp
  begin
***************
*** 520,523 ****
--- 552,567 ----
      FTimeDelay := Delay div 1000;
      FIc.uFlags := NIF_INFO;
+ 
+     // if we must cancel an existing balloon
+     if CancelPrevious then
+     begin
+       // then we call BalloonHint with title and info set to
+       // empty strings which surprisingly will cancel any existing
+       // balloon for the icon. This is clearly not documented by
+       // microsoft and may not work in later releases of Windows
+       // it has been tested on XP Home French
+       BalloonHint('','');
+     end;
+ 
      with FIc do
        StrPLCopy(szInfoTitle, Title, SizeOf(szInfoTitle) - 1);
***************
*** 538,541 ****
--- 582,597 ----
      Shell_NotifyIcon(NIM_MODIFY, PNotifyIconData(@FIc));
  
+     // if the delay is less than the system's minimum and the balloon
+     // was really shown (title and value are not empty)
+     if (Delay < GetSystemMinimumBalloonDelay) and
+         (Title <> '') and
+         (Value <> '') then
+     begin
+       // then we enable the ballon closer timer which will cancel
+       // the balloon when the delay is elapsed
+       FBalloonCloser.Interval := Delay;
+       FBalloonCloser.Enabled := true;
+     end;
+ 
      if Assigned(FOnBalloonShow) then
        FOnBalloonShow(self);
***************
*** 572,575 ****
--- 628,633 ----
    if Assigned(FOnMouseMove) then
      FOnMouseMove(Self, Shift, X, Y);
+   if Assigned(FOnHint) then
+     FOnHint(Self);
  end;