1614 lines
49 KiB
ObjectPascal
1614 lines
49 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
The contents of this file are subject to the Mozilla Public License
|
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
|
with the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is: JvTrayIcon.PAS, released on 2001-02-28.
|
|
|
|
The Initial Developer of the Original Code is S?stien Buysse [sbuysse att buypin dott com]
|
|
Portions created by S?stien Buysse are Copyright (C) 2001 S?stien Buysse.
|
|
All Rights Reserved.
|
|
|
|
Contributor(s):
|
|
Michael Beck [mbeck att bigfoot dott com].
|
|
Feng Mingyu(Winston Feng), [winstonf att tom dott com]
|
|
Hans-Eric Grnlund
|
|
Vlad S
|
|
|
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
|
located at http://jvcl.sourceforge.net
|
|
|
|
History:
|
|
2004-03-23
|
|
Added code to hide balloon correctly under W2k, as suggested by VladS
|
|
2004-02-29
|
|
VladS separate click and dblclick
|
|
2003-09-28 by Winston Feng
|
|
Add WM_SESSIONEND message handler, TaskbarRestart message handler to:
|
|
Clean the trayicon when session ends.
|
|
Restore the trayicon when session restart.
|
|
Remove the old unsuccessful DoCheckCrash method.
|
|
|
|
Known Issues:
|
|
-----------------------------------------------------------------------------}
|
|
// $Id: JvTrayIcon.pas 11184 2007-02-06 22:42:47Z remkobonte $
|
|
|
|
unit JvTrayIcon;
|
|
|
|
{$I jvcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls,
|
|
Menus, ShellAPI, ImgList,
|
|
{$IFDEF COMPILER6_UP}
|
|
DateUtils,
|
|
{$ENDIF COMPILER6_UP}
|
|
JvConsts, JvTypes, JvComponentBase;
|
|
|
|
type
|
|
TBalloonType = (btNone, btError, btInfo, btWarning);
|
|
|
|
TNotifyIconDataXP = record
|
|
cbSize: DWORD;
|
|
Wnd: THandle;
|
|
uID: UINT;
|
|
uFlags: UINT;
|
|
uCallbackMessage: UINT;
|
|
hIcon: HICON;
|
|
szTip: array [0..127] of AnsiChar; // 0..64 for pre 5.0 shell versions
|
|
dwState: DWORD;
|
|
dwStateMask: DWORD;
|
|
szInfo: array [0..255] of AnsiChar;
|
|
uTimeOut: DWORD;
|
|
szInfoTitle: array [0..63] of AnsiChar;
|
|
dwInfoFlags: DWORD;
|
|
end;
|
|
|
|
TAnimateEvent = procedure(Sender: TObject; const ImageIndex: Integer) of object;
|
|
|
|
{ (rb) Change tvVisibleTaskBar to tvStartHidden or something; tvVisibleTaskBar
|
|
is mainly used to indicate whether the application should start hidden
|
|
with a trayicon; Functionality of tvVisibleTaskBar is available at
|
|
run-time by using ShowApplication/HideApplication, at design-time it has
|
|
no use, except to indicate whether the application should start hidden.
|
|
Did not do the change because it changes the functionality of
|
|
the trayicon, and could not come up with a backwards compatible way
|
|
right-away }
|
|
TTrayVisibility = (tvVisibleTaskBar, tvVisibleTaskList, tvAutoHide, tvAutoHideIcon, tvVisibleDesign,
|
|
tvRestoreClick, tvRestoreDbClick, tvMinimizeClick, tvMinimizeDbClick, tvAnimateToTray,
|
|
tvNoRetryOnFailure);
|
|
TTrayVisibilities = set of TTrayVisibility;
|
|
|
|
TJvTrayIconState = (tisTrayIconVisible, tisAnimating, tisHooked, tisHintChanged,
|
|
tisWaitingForDoubleClick, tisAppHiddenButNotMinimized, tisClicked);
|
|
TJvTrayIconStates = set of TJvTrayIconState;
|
|
|
|
TJvTrayIcon = class(TJvComponent)
|
|
private
|
|
FTaskbarRestartMsg: Cardinal;
|
|
FCurrentIcon: TIcon;
|
|
FState: TJvTrayIconStates;
|
|
FStreamedActive: Boolean;
|
|
|
|
function GetApplicationVisible: Boolean;
|
|
procedure SetApplicationVisible(const Value: Boolean);
|
|
function GetIconVisible: Boolean;
|
|
procedure SetIconVisible(const Value: Boolean);
|
|
protected
|
|
FActive: Boolean;
|
|
FIcon: TIcon;
|
|
FIconData: TNotifyIconDataXP;
|
|
FHandle: THandle;
|
|
FHint: string;
|
|
FPopupMenu: TPopupMenu;
|
|
FOnClick: TMouseEvent;
|
|
FOnDblClick: TMouseEvent;
|
|
|
|
// Under Windows 2000, in order to hide a balloon hint, BalloonHint must be
|
|
// called with empty strings as many times it was called with real messages.
|
|
// So we keep a counter of the number of times ballon hint was called to
|
|
// track this and be sure to call a the right number of times when trying
|
|
// to hide the balloon
|
|
FBalloonCount: Integer;
|
|
|
|
{ Vlad S}
|
|
{
|
|
distinguish single-click and a double-click
|
|
Create a timer which is started on the first click, set the timeout value to
|
|
something a bit longer than the double-click, then connect the timeout() signal
|
|
to a slot of your own. When a double click event is received you simply stop
|
|
the timer. If the custom slot is visited you know that a single click was
|
|
done.
|
|
}
|
|
FClickedButton: TMouseButton;
|
|
FClickedShift: TShiftState;
|
|
FClickedX: Integer;
|
|
FClickedY: Integer;
|
|
{ Vlad S end.}
|
|
|
|
FOnMouseMove: TMouseMoveEvent;
|
|
FOnMouseDown: TMouseEvent;
|
|
FOnMouseUp: TMouseEvent;
|
|
FOnContextPopup: TContextPopupEvent;
|
|
FAnimated: Boolean;
|
|
FDelay: Cardinal;
|
|
FIcons: TCustomImageList;
|
|
FIconIndex: Integer;
|
|
FDropDownMenu: TPopupMenu;
|
|
FTask: Boolean;
|
|
FOnBalloonHide: TNotifyEvent;
|
|
FOnBalloonShow: TNotifyEvent;
|
|
FOnBalloonClick: TNotifyEvent;
|
|
FTime: TDateTime;
|
|
FTimeDelay: Integer;
|
|
FOnAnimate: TAnimateEvent;
|
|
FVisibility: TTrayVisibilities;
|
|
FSnap: Boolean;
|
|
function GetSystemMinimumBalloonDelay: Cardinal;
|
|
procedure DoAnimation;
|
|
procedure DoCloseBalloon;
|
|
procedure DoTimerDblClick; { Vlad S}
|
|
procedure IconChanged(Sender: TObject);
|
|
procedure SetActive(Value: Boolean);
|
|
procedure SetAnimated(const Value: Boolean);
|
|
procedure SetDelay(const Value: Cardinal);
|
|
procedure SetHint(Value: string);
|
|
procedure SetIcon(Value: TIcon);
|
|
procedure SetIconIndex(const Value: Integer);
|
|
procedure SetIcons(const Value: TCustomImageList);
|
|
procedure SetTask(const Value: Boolean);
|
|
procedure SetVisibility(const Value: TTrayVisibilities);
|
|
procedure StopTimer(ID: Integer);
|
|
procedure Hook;
|
|
procedure Unhook;
|
|
procedure WndProc(var Mesg: TMessage);
|
|
procedure DoContextPopup(X, Y: Integer);
|
|
procedure DoMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
procedure DoMouseMove(Shift: TShiftState; X, Y: Integer);
|
|
procedure DoMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
procedure DoDoubleClick(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
procedure DoClick(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
function ApplicationHook(var Msg: TMessage): Boolean;
|
|
function NotifyIcon(uFlags: UINT; dwMessage: DWORD): Boolean;
|
|
procedure SetCurrentIcon(Value: TIcon); //HEG: New
|
|
procedure IconPropertyChanged; //HEG: New
|
|
procedure Loaded; override; //HEG: New
|
|
|
|
procedure InitIconData;
|
|
|
|
procedure ShowTrayIcon;
|
|
procedure HideTrayIcon;
|
|
|
|
procedure StartAnimation;
|
|
procedure EndAnimation;
|
|
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
property CurrentIcon: TIcon read FCurrentIcon write SetCurrentIcon;
|
|
procedure HideApplication; virtual;
|
|
procedure ShowApplication; virtual;
|
|
procedure BalloonHint(Title, Value: string; BalloonType:
|
|
TBalloonType = btNone; ADelay: Cardinal = 5000; CancelPrevious: Boolean = False);
|
|
function AcceptBalloons: Boolean;
|
|
procedure HideBalloon;
|
|
function GetIconRect(var IconRect: TRect): Boolean;
|
|
|
|
property ApplicationVisible: Boolean read GetApplicationVisible write SetApplicationVisible;
|
|
property VisibleInTaskList: Boolean read FTask write SetTask default True;
|
|
property IconVisible: Boolean read GetIconVisible write SetIconVisible;
|
|
published
|
|
property Active: Boolean read FActive write SetActive default False;
|
|
property Animated: Boolean read FAnimated write SetAnimated default False;
|
|
property Icon: TIcon read FIcon write SetIcon;
|
|
property IconIndex: Integer read FIconIndex write SetIconIndex;
|
|
property Icons: TCustomImageList read FIcons write SetIcons;
|
|
property Hint: string read FHint write SetHint;
|
|
property DropDownMenu: TPopupMenu read FDropDownMenu write FDropDownMenu;
|
|
property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
|
|
property Delay: Cardinal read FDelay write SetDelay default 100;
|
|
property Snap: Boolean read FSnap write FSnap default False;
|
|
property Visibility: TTrayVisibilities read FVisibility write SetVisibility
|
|
default [tvVisibleTaskBar, tvVisibleTaskList, tvAutoHide];
|
|
property OnAnimate: TAnimateEvent read FOnAnimate write FOnAnimate;
|
|
property OnClick: TMouseEvent read FOnClick write FOnClick;
|
|
property OnDblClick: TMouseEvent read FOnDblClick write FOnDblClick;
|
|
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
|
|
property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
|
|
property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
|
|
property OnBalloonShow: TNotifyEvent read FOnBalloonShow write FOnBalloonShow;
|
|
property OnBalloonHide: TNotifyEvent read FOnBalloonHide write FOnBalloonHide;
|
|
property OnBalloonClick: TNotifyEvent read FOnBalloonClick write FOnBalloonClick;
|
|
property OnContextPopup: TContextPopupEvent read FOnContextPopup write FOnContextPopup;
|
|
end;
|
|
|
|
procedure RefreshTray;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvTrayIcon.pas $';
|
|
Revision: '$Revision: 11184 $';
|
|
Date: '$Date: 2007-02-06 23:42:47 +0100 (mar., 06 févr. 2007) $';
|
|
LogPath: 'JVCL\run'
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
uses
|
|
JvJCLUtils, JvJVCLUtils, CommCtrl;
|
|
|
|
type
|
|
TRegisterServiceProcess = function(dwProcessID, dwType: Integer): Integer; stdcall;
|
|
|
|
TExtraData = packed record
|
|
Wnd: THandle;
|
|
uID: UINT;
|
|
end;
|
|
|
|
TTrayIconEnumerator = class
|
|
private
|
|
FToolbarHandle: THandle;
|
|
FProcess: THandle;
|
|
FCount: Integer;
|
|
FData: Pointer;
|
|
FIndex: Integer;
|
|
FButton: TTBButton;
|
|
FExtraData: TExtraData;
|
|
procedure Init(const DataSize: Integer);
|
|
public
|
|
constructor Create; overload;
|
|
constructor Create(DataSize: Integer); overload;
|
|
destructor Destroy; override;
|
|
function MoveNext: Boolean;
|
|
|
|
function ReadProcessMemory(const Address: Pointer; Count: DWORD; var Buffer): Boolean;
|
|
|
|
property CurrentButton: TTBButton read FButton;
|
|
property CurrentWnd: THandle read FExtraData.Wnd;
|
|
property CurrentID: UINT read FExtraData.uID;
|
|
|
|
property ToolbarHandle: THandle read FToolbarHandle;
|
|
property Index: Integer read FIndex;
|
|
property Data: Pointer read FData;
|
|
end;
|
|
|
|
const
|
|
AnimationTimer = 1;
|
|
CloseBalloonTimer = 2;
|
|
DblClickTimer = 3;
|
|
|
|
cTaskbarIconIdentifier = 1;
|
|
|
|
// The hint size is 64 for pre IE 5.0 Shell32 versions, 128 for newer versions.
|
|
cHintSize: array [Boolean] of Cardinal = (64 - 1, 128 - 1); // -1 for trailing #0
|
|
|
|
Shell32VersionIE5 = $00050000;
|
|
|
|
WM_CALLBACKMESSAGE = WM_USER + 1;
|
|
|
|
// WIN32_IE >= = $0500
|
|
NIN_SELECT = (WM_USER + 0);
|
|
NINF_KEY = $1;
|
|
NIN_KEYSELECT = (NIN_SELECT or NINF_KEY);
|
|
|
|
// WIN32_IE >= = $0501
|
|
NIN_BALLOONSHOW = (WM_USER + 2);
|
|
NIN_BALLOONHIDE = (WM_USER + 3);
|
|
NIN_BALLOONTIMEOUT = (WM_USER + 4);
|
|
NIN_BALLOONUSERCLICK = (WM_USER + 5);
|
|
|
|
NIM_ADD = $00000000;
|
|
NIM_MODIFY = $00000001;
|
|
NIM_DELETE = $00000002;
|
|
// WIN32_IE >= = $0500
|
|
NIM_SETFOCUS = $00000003;
|
|
NIM_SETVERSION = $00000004;
|
|
NOTIFYICON_VERSION = 3;
|
|
|
|
NIF_MESSAGE = $00000001;
|
|
NIF_ICON = $00000002;
|
|
NIF_TIP = $00000004;
|
|
// WIN32_IE >= = $0500
|
|
NIF_STATE = $00000008;
|
|
NIF_INFO = $00000010;
|
|
// WIN32_IE >= = $600
|
|
NIF_GUID = $00000020;
|
|
|
|
// WIN32_IE >= = $0500
|
|
NIS_HIDDEN = $00000001;
|
|
NIS_SHAREDICON = $00000002;
|
|
|
|
// says this is the source of a shared icon
|
|
|
|
// Notify Icon Infotip flags
|
|
NIIF_NONE = $00000000;
|
|
// icon flags are mutually exclusive
|
|
// and take only the lowest 2 bits
|
|
NIIF_INFO = $00000001;
|
|
NIIF_WARNING = $00000002;
|
|
NIIF_ERROR = $00000003;
|
|
NIIF_ICON_MASK = $0000000F;
|
|
// WIN32_IE >= = $0501
|
|
NIIF_NOSOUND = $00000010;
|
|
|
|
Kernel32DLLName = 'kernel32.dll';
|
|
RegisterServiceProcessName = 'RegisterServiceProcess';
|
|
|
|
var
|
|
GKernel32Handle: THandle = 0;
|
|
GTriedLoadKernel32Dll: Boolean = False;
|
|
RegisterServiceProcess: TRegisterServiceProcess = nil;
|
|
|
|
{ We get the following messages while clicking:
|
|
|
|
Shell version < 5.0 | Shell version >= 5.0
|
|
|
|
|
Single click Double click | Single click Double click
|
|
|
|
|
WM_BUTTONDOWN WM_BUTTONDOWN | WM_BUTTONDOWN WM_BUTTONDOWN
|
|
WM_BUTTONUP WM_BUTTONUP | WM_BUTTONUP WM_BUTTONUP
|
|
WM_BUTTONDBLCLK | WM_CONTEXTMENU (*) WM_CONTEXTMENU (*)
|
|
WM_BUTTONUP | WM_BUTTONDBLCLK
|
|
| WM_BUTTONUP
|
|
| WM_CONTEXTMENU (*)
|
|
(*) if clicked with the right mouse button.
|
|
|
|
o We use the tisClicked flag to indicate that we received a WM_BUTTONDOWN;
|
|
if we receive a WM_BUTTONUP we can then make a difference between button ups
|
|
from double click and from single clicks. DoClick is thus not called twice
|
|
for double clicks.
|
|
(similar to csClicked flag in TControl.ControlState)
|
|
o Normal behaviour for window controls is to call both DoClick and DoDoubleClick
|
|
when the user double clicks the control. For the tray icon we don't want that.
|
|
We use the tisWaitingForDoubleClick flag to indicate that we received a
|
|
WM_BUTTONDOWN and WM_BUTTONUP and thus want to call DoClick. But instead of
|
|
calling DoClick we start a timer; if we receive a WM_BUTTONDBLCLK before the
|
|
timer ends, the user double clicked the icon otherwise it was a single click.
|
|
o For Shell32.dll versions before 5.0 we call DoContextPopup in WM_BUTTONUP
|
|
to simulate WM_CONTEXTMENU messages.
|
|
|
|
Thus the result is:
|
|
|
|
Shell version < 5.0 | Shell version >= 5.0
|
|
|
|
|
Single click Double click | Single click Double click
|
|
|
|
|
WM_BUTTONDOWN WM_BUTTONDOWN | WM_BUTTONDOWN WM_BUTTONDOWN
|
|
OnMouseDown OnMouseDown | OnMouseDown OnMouseDown
|
|
WM_BUTTONUP WM_BUTTONUP | WM_BUTTONUP WM_BUTTONUP
|
|
Start Timer Start Timer | Start Timer Start Timer
|
|
OnMouseUp OnMouseUp | OnMouseUp OnMouseUp
|
|
OnContextPopup (*) OnContextPopup (*)| WM_CONTEXTMENU (*) WM_CONTEXTMENU (*)
|
|
WM_TIMER WM_BUTTONDBLCLK | OnContextPopup OnContextPopup
|
|
OnClick (**) Stop Timer | WM_TIMER WM_BUTTONDBLCLK
|
|
OnDoubleClick | OnClick (**) Stop Timer
|
|
WM_BUTTONUP | OnDoubleClick
|
|
OnMouseUp | WM_BUTTONUP
|
|
OnContextPopup | OnMouseUp
|
|
| WM_CONTEXTMENU (*)
|
|
| OnContextPopup
|
|
|
|
(*) if clicked with the right mouse button.
|
|
(**) OnClick comes after the OnMouseUp. Another design decision could
|
|
be to also delay OnMouseUp.
|
|
}
|
|
|
|
function IsApplicationMinimized: Boolean;
|
|
begin
|
|
Result := IsIconic(Application.Handle);
|
|
end;
|
|
|
|
procedure UnloadKernel32Dll;
|
|
begin
|
|
RegisterServiceProcess := nil;
|
|
if GKernel32Handle > 0 then
|
|
FreeLibrary(GKernel32Handle);
|
|
GKernel32Handle := 0;
|
|
end;
|
|
|
|
procedure LoadKernel32Dll;
|
|
begin
|
|
if not GTriedLoadKernel32Dll then
|
|
begin
|
|
GTriedLoadKernel32Dll := True;
|
|
|
|
GKernel32Handle := Windows.LoadLibrary(Kernel32DLLName);
|
|
if GKernel32Handle > 0 then
|
|
RegisterServiceProcess := GetProcAddress(GKernel32Handle, RegisterServiceProcessName);
|
|
end;
|
|
end;
|
|
|
|
function GetTrayHandle: THandle;
|
|
var
|
|
ShellTrayHandle: THandle;
|
|
begin
|
|
ShellTrayHandle := FindWindow('Shell_TrayWnd', nil);
|
|
if ShellTrayHandle <> 0 then
|
|
Result := FindWindowEx(ShellTrayHandle, 0, 'TrayNotifyWnd', nil)
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
procedure AnimateToTray(AHandle: THandle);
|
|
var
|
|
SourceRect, DestRect: TRect;
|
|
TrayHandle: THandle;
|
|
begin
|
|
TrayHandle := GetTrayHandle;
|
|
if TrayHandle <> 0 then
|
|
begin
|
|
GetWindowRect(AHandle, SourceRect);
|
|
GetWindowRect(TrayHandle, DestRect);
|
|
|
|
DrawAnimatedRects(AHandle, IDANI_CAPTION, SourceRect, DestRect);
|
|
end;
|
|
end;
|
|
|
|
procedure AnimateFromTray(AHandle: THandle);
|
|
var
|
|
SourceRect, DestRect: TRect;
|
|
TrayHandle: THandle;
|
|
begin
|
|
TrayHandle := GetTrayHandle;
|
|
if TrayHandle <> 0 then
|
|
begin
|
|
GetWindowRect(TrayHandle, SourceRect);
|
|
GetWindowRect(AHandle, DestRect);
|
|
|
|
DrawAnimatedRects(AHandle, IDANI_CAPTION, SourceRect, DestRect);
|
|
end;
|
|
end;
|
|
|
|
function FindToolbar(Window: THandle; var ToolbarHandle: THandle): BOOL; stdcall;
|
|
var
|
|
Buf: array [Byte] of Char;
|
|
begin
|
|
GetClassName(Window, Buf, SizeOf(Buf));
|
|
// Set result to false when we have found a toolbar
|
|
Result := StrIComp(Buf, TOOLBARCLASSNAME) <> 0;
|
|
if not Result then
|
|
ToolbarHandle := Window;
|
|
end;
|
|
|
|
function GetToolbarHandle: THandle;
|
|
var
|
|
TrayHandle: THandle;
|
|
begin
|
|
Result := 0;
|
|
|
|
TrayHandle := GetTrayHandle;
|
|
if TrayHandle = 0 then
|
|
Exit;
|
|
|
|
EnumChildWindows(TrayHandle, @FindToolbar, Longint(@Result));
|
|
end;
|
|
|
|
function GetIconRect(const AWnd: THandle; const AID: UINT; var IconRect: TRect): Boolean;
|
|
begin
|
|
Result := False;
|
|
|
|
with TTrayIconEnumerator.Create(SizeOf(IconRect)) do
|
|
try
|
|
while MoveNext do
|
|
if (CurrentWnd = AWnd) and (CurrentID = AID) then
|
|
begin
|
|
// Button can be hidden in XP
|
|
if (CurrentButton.fsState and TBSTATE_HIDDEN) <> 0 then
|
|
Exit;
|
|
|
|
// Retrieve the button rectangle..
|
|
SendMessage(ToolbarHandle, TB_GETITEMRECT, Index, Longint(Data));
|
|
// ..and copy it to the current process. If it fails no need to continue
|
|
if not ReadProcessMemory(FData, SizeOf(IconRect), IconRect) then
|
|
Exit;
|
|
|
|
// Convert it to the desktop coordinate space
|
|
MapWindowPoints(ToolbarHandle, HWND_DESKTOP, IconRect.TopLeft, 2);
|
|
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure RefreshTray;
|
|
var
|
|
IconData: TNotifyIconData;
|
|
begin
|
|
FillChar(IconData, SizeOf(IconData), #0);
|
|
IconData.cbSize := SizeOf(IconData);
|
|
|
|
with TTrayIconEnumerator.Create do
|
|
try
|
|
while MoveNext do
|
|
if not IsWindow(CurrentWnd) then
|
|
begin
|
|
IconData.Wnd := CurrentWnd;
|
|
IconData.uID := CurrentID;
|
|
Shell_NotifyIcon(NIM_DELETE, @IconData);
|
|
end;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
//=== { TJvTrayIcon } ========================================================
|
|
|
|
constructor TJvTrayIcon.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FIcon := TIcon.Create;
|
|
FIcon.OnChange := IconChanged;
|
|
FCurrentIcon := TIcon.Create;
|
|
FSnap := False;
|
|
FHandle := AllocateHWndEx(WndProc);
|
|
|
|
FState := [];
|
|
FVisibility := [tvVisibleTaskBar, tvVisibleTaskList, tvAutoHide];
|
|
FAnimated := False;
|
|
FDelay := 100;
|
|
FIconIndex := 0;
|
|
FBalloonCount := 0;
|
|
FActive := False;
|
|
FTask := True;
|
|
|
|
{ (rb) todo: make global }
|
|
FTaskbarRestartMsg := RegisterWindowMessage('TaskbarCreated');
|
|
end;
|
|
|
|
destructor TJvTrayIcon.Destroy;
|
|
begin
|
|
StopTimer(DblClickTimer); { Vlad S}
|
|
StopTimer(CloseBalloonTimer);
|
|
|
|
SetActive(False);
|
|
|
|
if not (csDestroying in Application.ComponentState) then
|
|
SetTask(False);
|
|
|
|
FIcon.Free;
|
|
FCurrentIcon.Free;
|
|
DeallocateHWndEx(FHandle);
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TJvTrayIcon.AcceptBalloons: Boolean;
|
|
begin
|
|
// Balloons are only accepted with shell32.dll 5.0+
|
|
Result := GetShellVersion >= Shell32VersionIE5;
|
|
end;
|
|
|
|
function TJvTrayIcon.ApplicationHook(var Msg: TMessage): Boolean;
|
|
begin
|
|
if (Msg.Msg = WM_SYSCOMMAND) and (Msg.WParam = SC_MINIMIZE) and
|
|
(tvAutoHide in Visibility) and Active then
|
|
HideApplication;
|
|
Result := False;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.BalloonHint(Title, Value: string;
|
|
BalloonType: TBalloonType; ADelay: Cardinal; CancelPrevious: Boolean);
|
|
//http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/Shell/reference/functions/shell_notifyicon.asp
|
|
const
|
|
cInfoFlagValues: array [TBalloonType] of DWORD =
|
|
(NIIF_NONE, NIIF_ERROR, NIIF_INFO, NIIF_WARNING);
|
|
begin
|
|
if (tisTrayIconVisible in FState) and AcceptBalloons then
|
|
begin
|
|
FTime := Now;
|
|
FTimeDelay := ADelay div 1000;
|
|
|
|
// if we must cancel an existing balloon
|
|
if CancelPrevious then
|
|
HideBalloon;
|
|
|
|
with FIconData do
|
|
StrPLCopy(szInfoTitle, Title, SizeOf(szInfoTitle) - 1);
|
|
with FIconData do
|
|
StrPLCopy(szInfo, Value, SizeOf(szInfo) - 1);
|
|
|
|
FIconData.uTimeOut := ADelay;
|
|
FIconData.dwInfoFlags := cInfoFlagValues[BalloonType];
|
|
|
|
if NotifyIcon(NIF_INFO, NIM_MODIFY) then
|
|
begin
|
|
if (Title = '') and (Value = '') then
|
|
begin
|
|
Dec(FBalloonCount);
|
|
if FBalloonCount < 0 then
|
|
FBalloonCount := 0;
|
|
end
|
|
else
|
|
Inc(FBalloonCount);
|
|
|
|
// if the delay is less than the system's minimum and the balloon
|
|
// was really shown (title and value are not both empty)
|
|
// (rb) XP: if Value = '' then balloon is not shown
|
|
if (ADelay < GetSystemMinimumBalloonDelay) and ((Title <> '') or (Value <> '')) then
|
|
// then we enable the ballon closer timer which will cancel
|
|
// the balloon when the delay is elapsed
|
|
SetTimer(FHandle, CloseBalloonTimer, ADelay, nil);
|
|
|
|
if Assigned(FOnBalloonShow) then
|
|
FOnBalloonShow(Self);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.DoAnimation;
|
|
begin
|
|
if (tisTrayIconVisible in FState) and (FIcons <> nil) and (FIcons.Count > 0) then
|
|
begin
|
|
if IconIndex < 0 then
|
|
IconIndex := 0
|
|
else
|
|
IconIndex := (IconIndex + 1) mod FIcons.Count;
|
|
if Assigned(FOnAnimate) then
|
|
FOnAnimate(Self, IconIndex);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.DoClick(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
begin
|
|
if Assigned(FOnClick) then
|
|
FOnClick(Self, Button, Shift, X, Y);
|
|
if Button = mbLeft then
|
|
begin
|
|
if FDropDownMenu <> nil then
|
|
begin
|
|
SetForegroundWindow(FHandle);
|
|
FDropDownMenu.Popup(X, Y);
|
|
PostMessage(FHandle, WM_NULL, 0, 0);
|
|
end;
|
|
if ApplicationVisible then
|
|
begin
|
|
if tvMinimizeClick in Visibility then
|
|
{ (rb) Call Application.Minimize instead of HideApplication
|
|
if tvAutoHide not in Visibility ? }
|
|
HideApplication;
|
|
end
|
|
else
|
|
if tvRestoreClick in Visibility then
|
|
ShowApplication;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.DoCloseBalloon;
|
|
begin
|
|
// we stop the timer and hide the balloon
|
|
StopTimer(CloseBalloonTimer);
|
|
HideBalloon;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.DoContextPopup(X, Y: Integer);
|
|
var
|
|
Handled: Boolean;
|
|
begin
|
|
Handled := False;
|
|
if Assigned(FOnContextPopup) then
|
|
FOnContextPopup(Self, Point(X, Y), Handled);
|
|
if not Handled and Assigned(FPopupMenu) then
|
|
begin
|
|
SetForegroundWindow(FHandle);
|
|
FPopupMenu.Popup(X, Y);
|
|
PostMessage(FHandle, WM_NULL, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.DoDoubleClick(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if tisWaitingForDoubleClick in FState then
|
|
begin
|
|
Exclude(FState, tisWaitingForDoubleClick); { Vlad S}
|
|
StopTimer(DblClickTimer); { Vlad S}
|
|
end;
|
|
|
|
if Assigned(FOnDblClick) then
|
|
FOnDblClick(Self, Button, Shift, X, Y)
|
|
else
|
|
if Button = mbLeft then
|
|
begin
|
|
if FPopupMenu <> nil then
|
|
for I := 0 to FPopupMenu.Items.Count - 1 do
|
|
if FPopupMenu.Items[I].Default then
|
|
begin
|
|
FPopupMenu.Items[I].Click;
|
|
Break;
|
|
end;
|
|
if ApplicationVisible then
|
|
begin
|
|
if tvMinimizeDbClick in Visibility then
|
|
{ (rb) Call Application.Minimize instead of HideApplication
|
|
if tvAutoHide not in Visibility ? }
|
|
HideApplication;
|
|
end
|
|
else
|
|
if tvRestoreDbClick in Visibility then
|
|
ShowApplication;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.DoMouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
begin
|
|
Include(FState, tisClicked);
|
|
if Assigned(FOnMouseDown) then
|
|
FOnMouseDown(Self, Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TJvTrayIcon.DoMouseMove(Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
if tisHintChanged in FState then
|
|
begin
|
|
Exclude(FState, tisHintChanged);
|
|
|
|
with FIconData do
|
|
StrPLCopy(szTip, GetShortHint(FHint), cHintSize[GetShellVersion >= Shell32VersionIE5]);
|
|
|
|
if tisTrayIconVisible in FState then
|
|
NotifyIcon(NIF_TIP, NIM_MODIFY);
|
|
end;
|
|
if Assigned(FOnMouseMove) then
|
|
FOnMouseMove(Self, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TJvTrayIcon.DoMouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
|
|
function HasSingleClickFunctionality: Boolean;
|
|
begin
|
|
Result :=
|
|
Assigned(FOnClick) or
|
|
((Button = mbLeft) and (Assigned(FDropDownMenu) or
|
|
([tvRestoreClick, tvMinimizeClick] * Visibility <> [])));
|
|
end;
|
|
function HasDoubleClickFunctionality: Boolean;
|
|
begin
|
|
Result :=
|
|
Assigned(FOnDblClick) or
|
|
([tvRestoreDbClick, tvMinimizeDbClick] * Visibility <> []);
|
|
end;
|
|
begin
|
|
if tisClicked in FState then
|
|
begin
|
|
Exclude(FState, tisClicked);
|
|
if HasSingleClickFunctionality then
|
|
begin
|
|
if HasDoubleClickFunctionality then
|
|
begin
|
|
// Delay DoClick
|
|
FClickedButton := Button;
|
|
FClickedShift := Shift;
|
|
FClickedX := X;
|
|
FClickedY := Y;
|
|
|
|
if not (tisWaitingForDoubleClick in FState) then
|
|
begin
|
|
Include(FState, tisWaitingForDoubleClick);
|
|
SetTimer(FHandle, DblClickTimer, GetDoubleClickTime, nil);
|
|
end;
|
|
end
|
|
else
|
|
DoClick(Button, Shift, X, Y);
|
|
end;
|
|
//else
|
|
// DoClick(Button, Shift, X, Y);
|
|
end;
|
|
|
|
if Assigned(FOnMouseUp) then
|
|
FOnMouseUp(Self, Button, Shift, X, Y);
|
|
if (Button = mbRight) and (GetShellVersion < Shell32VersionIE5) then
|
|
DoContextPopup(X, Y);
|
|
end;
|
|
|
|
procedure TJvTrayIcon.DoTimerDblClick;
|
|
begin
|
|
StopTimer(DblClickTimer);
|
|
|
|
if tisWaitingForDoubleClick in FState then
|
|
begin
|
|
Exclude(FState, tisWaitingForDoubleClick);
|
|
// Double-clicking a mouse button actually generates four messages:
|
|
// WM_XBUTTONDOWN, WM_XBUTTONUP, WM_XBUTTONDBLCLK, and WM_XBUTTONUP again
|
|
DoClick(FClickedButton, FClickedShift, FClickedX, FClickedY);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.EndAnimation;
|
|
begin
|
|
// reentrance check
|
|
if tisAnimating in FState then
|
|
begin
|
|
Exclude(FState, tisAnimating);
|
|
StopTimer(AnimationTimer);
|
|
end;
|
|
end;
|
|
|
|
function TJvTrayIcon.GetApplicationVisible: Boolean;
|
|
begin
|
|
Result := not (tisAppHiddenButNotMinimized in FState) and not IsApplicationMinimized;
|
|
end;
|
|
|
|
function TJvTrayIcon.GetIconRect(var IconRect: TRect): Boolean;
|
|
begin
|
|
Result := JvTrayIcon.GetIconRect(Self.FHandle, cTaskbarIconIdentifier, IconRect);
|
|
end;
|
|
|
|
function TJvTrayIcon.GetIconVisible: Boolean;
|
|
begin
|
|
Result := tisTrayIconVisible in FState;
|
|
end;
|
|
|
|
function TJvTrayIcon.GetSystemMinimumBalloonDelay: Cardinal;
|
|
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.HideApplication;
|
|
begin
|
|
// Note: some actions will show/hide the taskbar button of the application,
|
|
// so we have to do them in a certain order.
|
|
|
|
if ApplicationVisible then
|
|
begin
|
|
// Custom animation?
|
|
if Snap or (tvAnimateToTray in Visibility) then
|
|
begin
|
|
if Assigned(Application.MainForm) then
|
|
begin
|
|
if tvAnimateToTray in Visibility then
|
|
AnimateToTray(Application.MainForm.Handle);
|
|
// To prevent another animation we have to set both
|
|
// ShowMainForm and MainForm.Visible to false
|
|
Application.MainForm.Visible := False;
|
|
end;
|
|
Application.ShowMainForm := False;
|
|
end;
|
|
// This will show the taskbar button
|
|
Application.Minimize;
|
|
end;
|
|
|
|
// ..and hide the taskbar button of the application
|
|
ShowWindow(Application.Handle, SW_HIDE);
|
|
Exclude(FVisibility, tvVisibleTaskBar);
|
|
|
|
if tvAutoHideIcon in Visibility then
|
|
ShowTrayIcon;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.HideBalloon;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
// 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
|
|
// Under Windows XP, you only need to do this once. But under
|
|
// Windows 2000, it seems one must do this one time more than
|
|
// there were calls to BalloonHint with real messages
|
|
|
|
// (rb) A bit confusing because calling BalloonHint changes FBalloonCount
|
|
for I := 0 to FBalloonCount do
|
|
BalloonHint('', '');
|
|
end;
|
|
|
|
procedure TJvTrayIcon.HideTrayIcon;
|
|
begin
|
|
// reentrance check
|
|
if tisTrayIconVisible in FState then
|
|
begin
|
|
EndAnimation;
|
|
|
|
if NotifyIcon(0, NIM_DELETE) then
|
|
Exclude(FState, tisTrayIconVisible);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.Hook;
|
|
begin
|
|
// reentrance check; also no hooking while designing
|
|
if (tisHooked in FState) or (csDesigning in ComponentState) then
|
|
Exit;
|
|
Include(FState, tisHooked);
|
|
Application.HookMainWindow(ApplicationHook);
|
|
end;
|
|
|
|
procedure TJvTrayIcon.IconChanged(Sender: TObject);
|
|
begin
|
|
IconPropertyChanged;
|
|
end;
|
|
|
|
//HEG: New
|
|
|
|
procedure TJvTrayIcon.IconPropertyChanged;
|
|
var
|
|
Ico: TIcon;
|
|
begin
|
|
if not (csLoading in ComponentState) then
|
|
begin
|
|
if (FIcons <> nil) and (FIconIndex >= 0) and (FIconIndex < FIcons.Count) then
|
|
begin
|
|
Ico := TIcon.Create;
|
|
try
|
|
FIcons.GetIcon(FIconIndex, Ico);
|
|
SetCurrentIcon(Ico);
|
|
finally
|
|
Ico.Free;
|
|
end;
|
|
end
|
|
else
|
|
if Assigned(Icon) and (not Icon.Empty) then
|
|
SetCurrentIcon(Icon)
|
|
else
|
|
SetCurrentIcon(Application.Icon);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.InitIconData;
|
|
begin
|
|
// http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/Shell/Structures/NOTIFYICONDATA.asp
|
|
with FIconData do
|
|
begin
|
|
if GetShellVersion >= Shell32VersionIE5 then
|
|
begin
|
|
cbSize := SizeOf(FIconData);
|
|
FIconData.uTimeOut := NOTIFYICON_VERSION;
|
|
end
|
|
else
|
|
cbSize := SizeOf(TNotifyIconData);
|
|
Wnd := FHandle;
|
|
// We have only 1 icon per FHandle, so no need to uniquely identify
|
|
uID := cTaskbarIconIdentifier;
|
|
uCallbackMessage := WM_CALLBACKMESSAGE;
|
|
if not CurrentIcon.Empty then
|
|
hIcon := CurrentIcon.Handle
|
|
else
|
|
CurrentIcon := Application.Icon;
|
|
StrPLCopy(szTip, GetShortHint(FHint), cHintSize[GetShellVersion >= Shell32VersionIE5]);
|
|
uFlags := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
|
|
IconPropertyChanged;
|
|
|
|
if FStreamedActive then
|
|
begin
|
|
SetActive(True);
|
|
|
|
if not (csDesigning in ComponentState) then
|
|
begin
|
|
if not (tvVisibleTaskBar in Visibility) then
|
|
begin
|
|
// Start hidden
|
|
Application.ShowMainForm := False;
|
|
// Note that the application is not really minimized
|
|
// (ie IsIconic(Application.Handle) = False), just hidden.
|
|
// Calling Application.Minimize or something would show the
|
|
// application's button on the taskbar for a short time.
|
|
// So we use the tisHiddenNotMinized flag as work-around, to indicate that
|
|
// the application is minimized.
|
|
|
|
Application.NormalizeTopMosts;
|
|
SetActiveWindow(Application.Handle);
|
|
ShowWinNoAnimate(Application.Handle, SW_HIDE);
|
|
Include(FState, tisAppHiddenButNotMinimized);
|
|
end;
|
|
|
|
if not (tvVisibleTaskList in Visibility) then
|
|
SetTask(False);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.Notification(AComponent: TComponent; Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if Operation = opRemove then
|
|
begin
|
|
if AComponent = DropDownMenu then
|
|
DropDownMenu := nil;
|
|
if AComponent = PopupMenu then
|
|
PopupMenu := nil;
|
|
if AComponent = Icons then
|
|
Icons := nil;
|
|
end;
|
|
end;
|
|
|
|
function TJvTrayIcon.NotifyIcon(uFlags: UINT; dwMessage: DWORD): Boolean;
|
|
const
|
|
cMaxRetryCount = 30; // arbitrary
|
|
cDelay = 1000; // arbitrary
|
|
var
|
|
ErrorCode: Integer;
|
|
RetryCount: Integer;
|
|
begin
|
|
FIconData.uFlags := uFlags;
|
|
Result := Shell_NotifyIcon(dwMessage, @FIconData);
|
|
if not Result and not (tvNoRetryOnFailure in Visibility) then
|
|
begin
|
|
{ Calling Shell_NotifyIcon can fail on XP when the shell is busy
|
|
See http://support.microsoft.com/default.aspx?scid=kb;ja;418138
|
|
|
|
Shell_NotifyIcon has a timeout of 4 sec. to complete. If that fails
|
|
because the shell is busy, then False is returned and GetLastError
|
|
returns ERROR_TIMEOUT (but testing shows that it can also return 0)
|
|
Solution is to wait a bit and retry.
|
|
|
|
However, even when GetLastError() returns ERROR_TIMEOUT,
|
|
the icon can often be actually added(or deleted).
|
|
|
|
If NIM_ADD times out and Shell_NotifyIcon(NIM_MODIFY) returns true,
|
|
the addition of the icon was actually successful.
|
|
Similarly, if NIM_DELETE times out and Shell_NotifyIcon(NIM_MODIFY) returns
|
|
false, the deletion of the icon was actually successful. (See Mantis #3747)
|
|
|
|
http://qc.borland.com/wc/qcmain.aspx?d=29306 provides steps to
|
|
reproduce this problem.
|
|
}
|
|
ErrorCode := GetLastError;
|
|
if (ErrorCode = 0) or (ErrorCode = ERROR_TIMEOUT) then
|
|
begin
|
|
RetryCount := 0;
|
|
repeat
|
|
Sleep(cDelay);
|
|
|
|
case dwMessage of
|
|
NIM_ADD: Result := Shell_NotifyIcon(NIM_MODIFY, @FIconData);
|
|
NIM_DELETE: Result := not Shell_NotifyIcon(NIM_MODIFY, @FIconData);
|
|
end;
|
|
|
|
if Result then
|
|
Exit;
|
|
|
|
Inc(RetryCount);
|
|
Result := Shell_NotifyIcon(dwMessage, @FIconData);
|
|
until Result or (RetryCount > cMaxRetryCount);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.SetActive(Value: Boolean);
|
|
begin
|
|
if csLoading in ComponentState then
|
|
FStreamedActive := Value
|
|
else
|
|
if FActive <> Value then
|
|
begin
|
|
FActive := Value;
|
|
if FActive then
|
|
begin
|
|
InitIconData;
|
|
Hook;
|
|
ShowTrayIcon;
|
|
end
|
|
else
|
|
begin
|
|
EndAnimation;
|
|
Unhook;
|
|
HideTrayIcon;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.SetAnimated(const Value: Boolean);
|
|
begin
|
|
if Value <> FAnimated then
|
|
begin
|
|
FAnimated := Value;
|
|
if FAnimated then
|
|
StartAnimation
|
|
else
|
|
EndAnimation;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.SetApplicationVisible(const Value: Boolean);
|
|
begin
|
|
if Value then
|
|
ShowApplication
|
|
else
|
|
HideApplication;
|
|
end;
|
|
|
|
//HEG: New
|
|
|
|
procedure TJvTrayIcon.SetCurrentIcon(Value: TIcon);
|
|
begin
|
|
FCurrentIcon.Assign(Value);
|
|
FIconData.hIcon := FCurrentIcon.Handle;
|
|
if tisTrayIconVisible in FState then
|
|
// if FIconData.hIcon = 0 then
|
|
// HideTrayIcon
|
|
// else
|
|
NotifyIcon(NIF_ICON, NIM_MODIFY);
|
|
end;
|
|
|
|
procedure TJvTrayIcon.SetDelay(const Value: Cardinal);
|
|
var
|
|
WasAnimated: Boolean;
|
|
begin
|
|
if FDelay <> Value then
|
|
begin
|
|
WasAnimated := Animated;
|
|
try
|
|
Animated := False;
|
|
FDelay := Value;
|
|
finally
|
|
Animated := WasAnimated;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.SetHint(Value: string);
|
|
begin
|
|
//Remove sLineBreak on w98/me as they are not supported
|
|
if GetShellVersion < Shell32VersionIE5 then
|
|
Value := StringReplace(Value, sLineBreak, ' - ', [rfReplaceAll]);
|
|
|
|
if FHint <> Value then
|
|
begin
|
|
{ (rb) No idea why this isn't applied immediately }
|
|
Include(FState, tisHintChanged);
|
|
FHint := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.SetIcon(Value: TIcon);
|
|
begin
|
|
// triggers IconPropertyChanged
|
|
FIcon.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvTrayIcon.SetIconIndex(const Value: Integer);
|
|
begin
|
|
if FIconIndex <> Value then
|
|
begin
|
|
FIconIndex := Value;
|
|
IconPropertyChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.SetIcons(const Value: TCustomImageList);
|
|
begin
|
|
if FIcons <> Value then
|
|
begin
|
|
FIcons := Value;
|
|
IconPropertyChanged; //HEG: New
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.SetIconVisible(const Value: Boolean);
|
|
begin
|
|
if Value then
|
|
ShowTrayIcon
|
|
else
|
|
HideTrayIcon;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.SetTask(const Value: Boolean);
|
|
begin
|
|
if FTask <> Value then
|
|
begin
|
|
FTask := Value;
|
|
if not (csDesigning in ComponentState) then
|
|
begin
|
|
LoadKernel32Dll;
|
|
|
|
if Assigned(RegisterServiceProcess) then
|
|
if FTask then
|
|
RegisterServiceProcess(GetCurrentProcessID, 0)
|
|
else
|
|
RegisterServiceProcess(GetCurrentProcessID, 1);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.SetVisibility(const Value: TTrayVisibilities);
|
|
var
|
|
ToBeSet, ToBeCleared: TTrayVisibilities;
|
|
begin
|
|
if Value <> FVisibility then
|
|
begin
|
|
ToBeSet := Value - FVisibility;
|
|
ToBeCleared := FVisibility - Value;
|
|
FVisibility := Value;
|
|
|
|
if not Active then
|
|
Exit;
|
|
|
|
if csDesigning in ComponentState then
|
|
begin
|
|
if tvVisibleDesign in ToBeSet then
|
|
ShowTrayIcon
|
|
else
|
|
if tvVisibleDesign in ToBeCleared then
|
|
HideTrayIcon;
|
|
end
|
|
else
|
|
begin
|
|
VisibleInTaskList := tvVisibleTaskList in FVisibility;
|
|
|
|
if tvAutoHide in ToBeSet then
|
|
begin
|
|
if not ApplicationVisible then
|
|
HideApplication;
|
|
end;
|
|
|
|
if tvVisibleTaskBar in ToBeSet then
|
|
ShowApplication
|
|
else
|
|
if tvVisibleTaskBar in ToBeCleared then
|
|
HideApplication;
|
|
|
|
if (tvAutoHideIcon in ToBeSet) and not IsApplicationMinimized then
|
|
HideTrayIcon;
|
|
if (tvAutoHideIcon in ToBeCleared) and not IsApplicationMinimized then
|
|
ShowTrayIcon;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.ShowApplication;
|
|
begin
|
|
// Note: some actions will show/hide the taskbar button of the application,
|
|
// so we have to do them in a certain order.
|
|
|
|
if tisAppHiddenButNotMinimized in FState then
|
|
begin
|
|
// Make the application not iconic; this will show the taskbar button
|
|
ShowWinNoAnimate(Application.Handle, SW_MINIMIZE);
|
|
// If we set ShowMainForm to true we get an animation when we call
|
|
// Application.Restore
|
|
if not Snap and not (tvAnimateToTray in Visibility) then
|
|
Application.ShowMainForm := True;
|
|
end;
|
|
|
|
// Show the taskbar button of the application..
|
|
Include(FVisibility, tvVisibleTaskBar);
|
|
ShowWindow(Application.Handle, SW_SHOW);
|
|
|
|
if not ApplicationVisible then
|
|
begin
|
|
if (tvAnimateToTray in Visibility) and Assigned(Application.MainForm) then
|
|
AnimateFromTray(Application.MainForm.Handle);
|
|
// ..and restore the application
|
|
Application.Restore;
|
|
if Application.MainForm <> nil then
|
|
Application.MainForm.Visible := True;
|
|
end;
|
|
|
|
Exclude(FState, tisAppHiddenButNotMinimized);
|
|
if tvAutoHideIcon in Visibility then
|
|
HideTrayIcon;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.ShowTrayIcon;
|
|
begin
|
|
// reentrance check
|
|
if tisTrayIconVisible in FState then
|
|
Exit;
|
|
|
|
if not Active then
|
|
Exit;
|
|
|
|
if csDesigning in ComponentState then
|
|
begin
|
|
if not (tvVisibleDesign in Visibility) then
|
|
Exit;
|
|
end
|
|
else
|
|
if (tvAutoHideIcon in Visibility) and ApplicationVisible then
|
|
Exit;
|
|
|
|
// All checks passed, make the trayicon visible:
|
|
|
|
if NotifyIcon(NIF_MESSAGE or NIF_ICON or NIF_TIP, NIM_ADD) then
|
|
begin
|
|
Include(FState, tisTrayIconVisible);
|
|
|
|
// If we call NIM_SETVERSION, we must call it *after* NIM_ADD.
|
|
if GetShellVersion >= Shell32VersionIE5 then
|
|
NotifyIcon(0, NIM_SETVERSION);
|
|
|
|
if Animated then
|
|
StartAnimation;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.StartAnimation;
|
|
begin
|
|
// reentrance check, and trayicon needs to be visible
|
|
if [tisAnimating, tisTrayIconVisible] * FState = [tisTrayIconVisible] then
|
|
begin
|
|
Include(FState, tisAnimating);
|
|
SetTimer(FHandle, AnimationTimer, FDelay, nil)
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.StopTimer(ID: Integer);
|
|
begin
|
|
if FHandle <> 0 then
|
|
KillTimer(FHandle, ID);
|
|
end;
|
|
|
|
procedure TJvTrayIcon.Unhook;
|
|
begin
|
|
// reentrance check
|
|
if tisHooked in FState then
|
|
begin
|
|
Exclude(FState, tisHooked);
|
|
Application.UnhookMainWindow(ApplicationHook);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTrayIcon.WndProc(var Mesg: TMessage);
|
|
var
|
|
I: Integer;
|
|
Pt: TPoint;
|
|
ShState: TShiftState;
|
|
begin
|
|
try
|
|
with Mesg do
|
|
case Msg of
|
|
WM_CALLBACKMESSAGE:
|
|
if not (csDesigning in ComponentState) then
|
|
begin
|
|
GetCursorPos(Pt);
|
|
ShState := [];
|
|
if GetKeyState(VK_SHIFT) < 0 then
|
|
Include(ShState, ssShift);
|
|
if GetKeyState(VK_CONTROL) < 0 then
|
|
Include(ShState, ssCtrl);
|
|
if GetKeyState(VK_LBUTTON) < 0 then
|
|
Include(ShState, ssLeft);
|
|
if GetKeyState(VK_RBUTTON) < 0 then
|
|
Include(ShState, ssRight);
|
|
if GetKeyState(VK_MBUTTON) < 0 then
|
|
Include(ShState, ssMiddle);
|
|
if GetKeyState(VK_MENU) < 0 then
|
|
Include(ShState, ssAlt);
|
|
case LParam of
|
|
WM_MOUSEMOVE:
|
|
DoMouseMove(ShState, Pt.X, Pt.Y);
|
|
WM_LBUTTONDOWN:
|
|
DoMouseDown(mbLeft, ShState, Pt.X, Pt.Y);
|
|
WM_RBUTTONDOWN:
|
|
DoMouseDown(mbRight, ShState, Pt.X, Pt.Y);
|
|
WM_MBUTTONDOWN:
|
|
DoMouseDown(mbMiddle, ShState, Pt.X, Pt.Y);
|
|
WM_LBUTTONUP:
|
|
DoMouseUp(mbLeft, ShState, Pt.X, Pt.Y);
|
|
WM_MBUTTONUP:
|
|
DoMouseUp(mbMiddle, ShState, Pt.X, Pt.Y);
|
|
WM_RBUTTONUP:
|
|
DoMouseUp(mbRight, ShState, Pt.X, Pt.Y);
|
|
WM_CONTEXTMENU, NIN_KEYSELECT:
|
|
// WM_CONTEXTMENU: press Shift+F10 while trayicon has focus.
|
|
// NIN_KEYSELECT: press Enter or Space while trayicon has focus.
|
|
// Windows moves the mouse pointer to the trayicon before these messages,
|
|
// so Pt is valid.
|
|
DoContextPopup(Pt.X, Pt.Y);
|
|
WM_LBUTTONDBLCLK:
|
|
DoDoubleClick(mbLeft, ShState, Pt.X, Pt.Y);
|
|
WM_RBUTTONDBLCLK:
|
|
DoDoubleClick(mbRight, ShState, Pt.X, Pt.Y);
|
|
WM_MBUTTONDBLCLK:
|
|
DoDoubleClick(mbMiddle, ShState, Pt.X, Pt.Y);
|
|
NIN_BALLOONHIDE: //sb
|
|
begin
|
|
{ (rb) Double try..except }
|
|
try
|
|
if Assigned(FOnBalloonHide) then
|
|
FOnBalloonHide(Self);
|
|
except
|
|
end;
|
|
Result := Ord(True);
|
|
end;
|
|
NIN_BALLOONTIMEOUT: //sb
|
|
begin
|
|
I := SecondsBetween(Now, FTime);
|
|
if I > FTimeDelay then
|
|
HideBalloon;
|
|
Result := Ord(True);
|
|
end;
|
|
NIN_BALLOONUSERCLICK: //sb
|
|
begin
|
|
{ (rb) Double try..except }
|
|
try
|
|
if Assigned(FOnBalloonClick) then
|
|
FOnBalloonClick(Self);
|
|
except
|
|
end;
|
|
Result := Ord(True);
|
|
//Result := DefWindowProc(FHandle, Msg, WParam, LParam);
|
|
HideBalloon;
|
|
end;
|
|
end;
|
|
end;
|
|
// Add by Winston Feng 2003-9-28
|
|
// Handle the QueryEndSession and TaskbarCreated message, so trayicon
|
|
// will be deleted and restored correctly.
|
|
WM_QUERYENDSESSION:
|
|
Result := 1;
|
|
WM_ENDSESSION:
|
|
// (rb) Is it really necessairy to respond to WM_ENDSESSION?
|
|
if TWMEndSession(Mesg).EndSession then
|
|
HideTrayIcon
|
|
else
|
|
if Active then
|
|
ShowTrayIcon;
|
|
WM_TIMER:
|
|
case TWMTimer(Mesg).TimerID of
|
|
AnimationTimer:
|
|
DoAnimation;
|
|
CloseBalloonTimer:
|
|
DoCloseBalloon;
|
|
DblClickTimer:
|
|
DoTimerDblClick;
|
|
end;
|
|
else
|
|
if Msg = FTaskbarRestartMsg then
|
|
begin
|
|
{ You can test this on XP:
|
|
- Click Start, then click Turn Off Computer
|
|
- Press CTRL + Shift + Alt + Click Cancel (all at once)
|
|
this will dump explorer.exe
|
|
- Press CTRL + Alt + Delete
|
|
- Click New Task...
|
|
- Enter 'explorer.exe' and click OK.
|
|
this will restart explorer.exe
|
|
}
|
|
|
|
// Ensure tisTrayIconVisible is not in FState:
|
|
HideTrayIcon;
|
|
if Active then
|
|
ShowTrayIcon;
|
|
end
|
|
else
|
|
Result := DefWindowProc(FHandle, Msg, WParam, LParam);
|
|
end; // case
|
|
except
|
|
Application.HandleException(Self);
|
|
end;
|
|
end;
|
|
|
|
//=== { TTrayIconEnumerator } ================================================
|
|
|
|
constructor TTrayIconEnumerator.Create(DataSize: Integer);
|
|
begin
|
|
inherited Create;
|
|
if DataSize < SizeOf(TTBButton) then
|
|
DataSize := SizeOf(TTBButton);
|
|
Init(DataSize);
|
|
FIndex := FCount;
|
|
end;
|
|
|
|
constructor TTrayIconEnumerator.Create;
|
|
begin
|
|
inherited Create;
|
|
Init(SizeOf(TTBButton));
|
|
FIndex := FCount;
|
|
end;
|
|
|
|
destructor TTrayIconEnumerator.Destroy;
|
|
begin
|
|
if FData <> nil then
|
|
VirtualFreeEx(FProcess, FData, 0, MEM_RELEASE);
|
|
if FProcess <> 0 then
|
|
CloseHandle(FProcess);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TTrayIconEnumerator.Init(const DataSize: Integer);
|
|
{ Taken from http://www.thecodeproject.com/shell/ctrayiconposition.asp }
|
|
var
|
|
ProcessID: DWORD;
|
|
begin
|
|
// The trayicons are actually buttons on a toolbar
|
|
FToolbarHandle := GetToolbarHandle;
|
|
if FToolbarHandle = 0 then
|
|
Exit;
|
|
|
|
FCount := SendMessage(FToolbarHandle, TB_BUTTONCOUNT, 0, 0);
|
|
if FCount < 1 then
|
|
Exit;
|
|
|
|
// We want to get data from another process - it's not possible
|
|
// to just send messages like TB_GETBUTTON with a locally
|
|
// allocated buffer for return data. Pointer to locally allocated
|
|
// data has no usefull meaning in a context of another
|
|
// process (since Win95) - so we need
|
|
// to allocate some memory inside Tray process.
|
|
// Use @ProcessId for C5/D5 compatibility
|
|
|
|
if GetWindowThreadProcessId(FToolbarHandle, @ProcessID) = 0 then
|
|
Exit;
|
|
|
|
FProcess := OpenProcess(PROCESS_ALL_ACCESS, False, ProcessID);
|
|
if FProcess = 0 then
|
|
Exit;
|
|
|
|
// Allocate needed memory in the context of the tray process. We reuse
|
|
// Data to read multiple parts so we set it to the biggest chunk we need
|
|
// (TTBButton)
|
|
FData := VirtualAllocEx(FProcess, nil, DataSize, MEM_COMMIT, PAGE_READWRITE);
|
|
end;
|
|
|
|
function TTrayIconEnumerator.MoveNext: Boolean;
|
|
begin
|
|
Result := False;
|
|
|
|
if (FProcess = 0) or not Assigned(FData) then
|
|
Exit;
|
|
|
|
Dec(FIndex);
|
|
|
|
while FIndex >= 0 do
|
|
begin
|
|
SendMessage(FToolbarHandle, TB_GETBUTTON, FIndex, Longint(FData));
|
|
|
|
// Read the data from the tray process into the current process.
|
|
if ReadProcessMemory(FData, SizeOf(FButton), FButton) then
|
|
begin
|
|
// Read the extra data, Button.dwData points to its location
|
|
if ReadProcessMemory(Pointer(FButton.dwData), SizeOf(FExtraData), FExtraData) then
|
|
begin
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
Dec(FIndex);
|
|
end;
|
|
end;
|
|
|
|
function TTrayIconEnumerator.ReadProcessMemory(const Address: Pointer;
|
|
Count: DWORD; var Buffer): Boolean;
|
|
var
|
|
BytesRead: DWORD;
|
|
begin
|
|
Result := Windows.ReadProcessMemory(FProcess, Address, @Buffer, Count, BytesRead) and
|
|
(BytesRead = Count);
|
|
end;
|
|
|
|
initialization
|
|
{$IFDEF UNITVERSIONING}
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
finalization
|
|
UnloadKernel32Dll;
|
|
{$IFDEF UNITVERSIONING}
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end.
|