...Ballon Tips für das Tray Icon anzeigen?

Autor: happyjoe

Kategorie: System

{
  Use the AddSysTrayIcon procedure to add icon to notification area
  (in FormCreate, for example), and use the ShowBalloonTips procedure
  when ever you want(of cause must after you called AddSysTrayIcon procedure),
  and finally call DeleteSysTrayIcon procedure to remove icon from
  notification area after your using.
  Add propriety code to the callback message handler.

  The new feature require IE5 or later.
}

unit Unit1;

interface

uses
  
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

{new constant definitions}

const
  
NIF_INFO = $10;
  NIF_MESSAGE = 1;
  NIF_ICON = 2;
  NOTIFYICON_VERSION = 3;
  NIF_TIP = 4;
  NIM_SETVERSION = $00000004;
  NIM_SETFOCUS = $00000003;
  NIIF_INFO = $00000001;
  NIIF_WARNING = $00000002;
  NIIF_ERROR = $00000003;

  NIN_BALLOONSHOW = WM_USER + 2;
  NIN_BALLOONHIDE = WM_USER + 3;
  NIN_BALLOONTIMEOUT = WM_USER + 4;
  NIN_BALLOONUSERCLICK = WM_USER + 5;
  NIN_SELECT = WM_USER + 0;
  NINF_KEY = $1;
  NIN_KEYSELECT = NIN_SELECT or NINF_KEY;
  
  NIN_BALLOONSHOW = WM_USER + 2;
  NIN_BALLOONHIDE = WM_USER + 3;
  NIN_BALLOONTIMEOUT = WM_USER + 4;
  NIN_BALLOONUSERCLICK = WM_USER + 5;
  NIN_SELECT = WM_USER + 0;
  NINF_KEY = $1;
  NIN_KEYSELECT = NIN_SELECT or NINF_KEY;
  {other constants can be found in vs.net---vc7's dir: PlatformSDK\Include\ShellAPI.h}

  {define the callback message}
  
TRAY_CALLBACK = WM_USER + $7258;

  {new NotifyIconData structure definition}
type
  
PNewNotifyIconData = ^TNewNotifyIconData;
  TDUMMYUNIONNAME    = record
    case 
Integer of
      
0: (uTimeout: UINT);
      1: (uVersion: UINT);
  end;

  TNewNotifyIconData = record
    
cbSize: DWORD;
    Wnd: HWND;
    uID: UINT;
    uFlags: UINT;
    uCallbackMessage: UINT;
    hIcon: HICON;
   //Version 5.0 is 128 chars, old ver is 64 chars
    
szTip: array [0..127] of Char;
    dwState: DWORD; //Version 5.0
    
dwStateMask: DWORD; //Version 5.0
    
szInfo: array [0..255] of Char; //Version 5.0
    
DUMMYUNIONNAME: TDUMMYUNIONNAME;
    szInfoTitle: array [0..63] of Char; //Version 5.0
    
dwInfoFlags: DWORD;   //Version 5.0
  
end;


type
  
TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    
IconData: TNewNotifyIconData;
    procedure SysTrayIconMsgHandler(var Msg: TMessage); message TRAY_CALLBACK;
    procedure AddSysTrayIcon;
    procedure ShowBalloonTips;
    procedure DeleteSysTrayIcon;
  public
  end
;

var
  
Form1: TForm1;

implementation

{$R *.DFM}

uses
  
ShellAPI;

procedure TForm1.SysTrayIconMsgHandler(var Msg: TMessage);
begin
  case 
Msg.lParam of
    
WM_MOUSEMOVE:;
    WM_LBUTTONDOWN:;
    WM_LBUTTONUP:;
    WM_LBUTTONDBLCLK:;
    WM_RBUTTONDOWN:;
    WM_RBUTTONUP:;
    WM_RBUTTONDBLCLK:;
    //followed by the new messages
    
NIN_BALLOONSHOW:
    {Sent when the balloon is shown}
      
ShowMessage('NIN_BALLOONSHOW');
    NIN_BALLOONHIDE:
    {Sent when the balloon disappears?Rwhen the icon is deleted,
    for example. This message is not sent if the balloon is dismissed because of
    a timeout or mouse click by the user. }
      
ShowMessage('NIN_BALLOONHIDE');
    NIN_BALLOONTIMEOUT:
    {Sent when the balloon is dismissed because of a timeout.}
      
ShowMessage('NIN_BALLOONTIMEOUT');
    NIN_BALLOONUSERCLICK:
    {Sent when the balloon is dismissed because the user clicked the mouse.
    Note: in XP there's Close button on he balloon tips, when click the button,
    send NIN_BALLOONTIMEOUT message actually.}
      
ShowMessage('NIN_BALLOONUSERCLICK');
  end;
end;

  {AddSysTrayIcon procedure add an icon to notification area}
procedure TForm1.AddSysTrayIcon;
begin
  
IconData.cbSize := SizeOf(IconData);
  IconData.Wnd := AllocateHWnd(SysTrayIconMsgHandler);
  {SysTrayIconMsgHandler is then callback message' handler}
  
IconData.uID := 0;
  IconData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
  IconData.uCallbackMessage := TRAY_CALLBACK;   //user defined callback message
  
IconData.hIcon := Application.Icon.Handle;    //an Icon's Handle
  
IconData.szTip := 'Please send me email.';
  if not Shell_NotifyIcon(NIM_ADD, @IconData) then
    
ShowMessage('add fail');
end;

{ShowBalloonTips procedure carry out the new feature: Balloon Tips}
procedure TForm1.ShowBalloonTips;
var
  
TipInfo, TipTitle: string;
begin
  
IconData.cbSize := SizeOf(IconData);
  IconData.uFlags := NIF_INFO;
  TipInfo := 'Please send me email.';
  strPLCopy(IconData.szInfo, TipInfo, SizeOf(IconData.szInfo) - 1);
  IconData.DUMMYUNIONNAME.uTimeout := 3000;
  TipTitle := 'Happyjoe@21cn.com';
  strPLCopy(IconData.szInfoTitle, TipTitle, SizeOf(IconData.szInfoTitle) - 1);
  IconData.dwInfoFlags := NIIF_INFO;     //NIIF_ERROR;  //NIIF_WARNING;
  
Shell_NotifyIcon(NIM_MODIFY, @IconData);
  {in my testing, the following code has no use}
  
IconData.DUMMYUNIONNAME.uVersion := NOTIFYICON_VERSION;
  if not Shell_NotifyIcon(NIM_SETVERSION, @IconData) then
    
ShowMessage('setversion fail');
end;

{here's the deletion procedure}
procedure TForm1.DeleteSysTrayIcon;
begin
  
DeallocateHWnd(IconData.Wnd);
  if not Shell_NotifyIcon(NIM_DELETE, @IconData) then
    
ShowMessage('delete fail');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  
AddSysTrayIcon;
  ShowBalloonTips;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  
DeleteSysTrayIcon;
end;

end.

 

printed from
www.swissdelphicenter.ch
developers knowledge base