Title: Popping Balloons
Question: I like the balloons that pops up in the Window 2000 tray area. How do I get them in my programs?
Answer:
This behavior can be accomplished by using the Shell_NotifyIcon with the proper flags. A good example is the Daniel Zakharov's article.
As Daniel indicated in his article there is another article from Bernhard Angerer showing an interesting (and simple) component to manage tray icons.
My task here is to join the informations from both articles to get a working component ready for Windows 2000 and ballooning.
First of all I suggest to remove the line added by Bernhard in the constructor of its component: when used at design-time the Application.Handle seems to refer to Delphi main window (at least in version 5.0). This lead the entire IDE to behave in a quite strange way.
A possible solution to this problem is to modify the constructor in this way:
if not (csDesigning in ComponentState) then
SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
This change add the WS_EX_TOOLWINDOW style to the main window at run-time only.
And now for the fleshy part!
Step 1: Add the new flag and messages needed for ballooning.
const
WM_TOOLTRAYICON = WM_USER+1;
WM_RESETTOOLTIP = WM_USER+2;
NIF_INFO = $00000010;
NIIF_NONE = $00000000;
NIIF_INFO = $00000001;
NIIF_WARNING = $00000002;
NIIF_ERROR = $00000003;
Step 2: Add a new version for the TNotifyIconData structure. I call this structure TNotifyIconData50
TNotifyIconData50 = record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array[0..127] of AnsiChar;
dwState: DWORD;
dwStateMask: DWORD;
szInfo: array[0..255] of AnsiChar;
uTimeout: UINT; // union with uVersion: UINT;
szInfoTitle: array[0..63] of AnsiChar;
dwInfoFlags: DWORD;
end{record};
Step 3: Add some new helper types (used later).
TBalloonTimeout = 10..30; {seconds}
TBalloonIconType = (bitNone, // no icon
bitInfo, // information icon (blue)
bitWarning, // exclamation icon (yellow)
bitError); // error icon (red)
Step 4: Replace the references to TNOTIFYICONDATA with TNotifyIconData50. In the component there are just two
This is the first one...
...
TTrayIcon = class(TComponent)
private
{ Field Variables }
IconData: TNotifyIconData50;
fIcon : TIcon;
...
This is the second one...
...
procedure TTrayIcon.FillDataStructure;
begin
with IconData do
begin
cbSize := SizeOf(TNotifyIconData50);
wnd := FWindowHandle;
uID := 0; // is not passed in with message so make it 0
uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
hIcon := fIcon.Handle;
StrPCopy(szTip,fToolTip);
uCallbackMessage := WM_TOOLTRAYICON;
end;
end;
Step 5: Add the Balloon() method to the public section of the class and to the body of source:
...
public
constructor create(aOwner : TComponent); override;
destructor destroy; override;
function Balloon(Title: String; Text: string; IconType: TBalloonIconType; Timeout: TBalloonTimeout): Boolean;
...
...
function TTrayIcon.Balloon(Title: String; Text: string; IconType: TBalloonIconType; Timeout: TBalloonTimeout): Boolean;
const
aBalloonIconTypes: array[TBalloonIconType] of Byte = (NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR);
begin
if fActive then
begin
//Removes old balloon
FillDataStructure;
with IconData do
begin
uFlags := uFlags or NIF_INFO;
StrPCopy(szInfo, '');
end{with};
Shell_NotifyIcon(NIM_MODIFY, @IconData);
//Shows new balloon
FillDataStructure;
with IconData do
begin
uFlags := uFlags or NIF_INFO;
StrPCopy(szInfo, Text);
uTimeout := Timeout * 1000;
StrPCopy(szInfoTitle, Title);
dwInfoFlags := aBalloonIconTypes[IconType];
end{with};
Result := Shell_NotifyIcon(NIM_MODIFY, @IconData)
end
else
result := True;
end;
...
Enjoy!