API - mostrando balão hint no systray igual ao windows xp

Top  Previous  Next

// mostrando balão hint no systray igual ao windows xp

 

  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

   

  {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..127of Char; 

    dwState: DWORD; //Version 5.0 

    dwStateMask: DWORD; //Version 5.0 

    szInfo: array [0..255of Char; //Version 5.0 

    DUMMYUNIONNAME: TDUMMYUNIONNAME; 

    szInfoTitle: array [0..63of 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