程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> 支持XP下托盤欄氣球提示的托盤單元

支持XP下托盤欄氣球提示的托盤單元

編輯:Delphi
unit tray;

  interface
  uses
     Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs,Registry,ShellAPI, ComCtrls, StdCtrls, Buttons, Menus, ExtCtrls;

  const
    ICON_ID=3;
    NIF_INFO = $10;
    NIM_SETVERSION = $00000004;
    NOTIFYICON_VERSION = 3;
    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;

  procedure InstIcon(ToyIcon:TIcon;WinHandle:THandle;cbMessage:Integer);
  procedure DeleIcon(winHandle:THandle);
  procedure ShowBalloonTips(TipInfo,TipTitle:string);

  
  implementation

  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;
      szTip: array [0..127] of Char;    //Version 5.0為128個,以前為64個
      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;

  var
    IconData: TNewNotifyIconData;

  procedure InstIcon(ToyIcon:TIcon;WinHandle:THandle;cbMessage:Integer);
  begin
    IconData.cbSize:=Sizeof(IconData);
    IconData.Wnd:=WinHandle;
    IconData.uID:=ICON_ID;
    IconData.uFlags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;
    IconData.uCallbackMessage:=cbMessage;
    IconData.hIcon:=ToyIcon.Handle;
    IconData.szTip:='LavaTech--Enhance the life!';       //使用是該修改
    Shell_NotifyIcon(NIM_ADD,@IconData);
  end;

  procedure DeleIcon(winHandle:THandle);
  begin
    IconData.cbSize:=SizeOf(IconData);
    IconData.Wnd:=winHandle;
    IconData.uID:=ICON_ID;
    Shell_NotifyIcon(NIM_DELETE,@IconData);
  end;

  procedure ShowBalloonTips(TipInfo,TipTitle:string);
  begin
    IconData.cbSize := sizeof(IconData);
    IconData.uFlags := NIF_INFO;
    strPLCopy(IconData.szInfo, TipInfo, sizeof(IconData.szInfo) - 1);
    IconData.DUMMYUNIONNAME.uTimeout := 3000;
    strPLCopy(IconData.szInfoTitle, TipTitle, sizeof(IconData.szInfoTitle) - 1);
    IconData.dwInfoFlags := NIIF_INFO;
    Shell_NotifyIcon(NIM_MODIFY, @IconData);
  end;

  end.

  {
  //使用簡介:IconOnClick
  //先添加常量, InstIcon(Application.Icon, Handle,WM_ICONEVENT);這裡要用到的
  WM_ICONEVENT=WM_USER+111;
  //申明部分
  procedure IconOnClick(var message:TMessage);message WM_ICONEVENT;
  //實現部分
  procedure TForm1.IconOnClick(var message:Tmessage);
  var
    p:Tpoint;
  begin
    if (message.LParam=WM_LBUTTONDBLCLK) then
    begin
      //雙擊左鍵
    end;
    if (message.LParam=WM_RBUTTONDOWN) then
    begin
      GetCursorPos(p);
      PopupMenu1.Popup(p.X,p.Y);
    end;
  end;

  }

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved