delphi 托盘区 气泡提示

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ShellApi, StdCtrls, Menus;
const
WM_POP_MESSAGE = WM_USER + 1; //自定义消息 MSN提示窗口...
WM_ICONTRAY = WM_USER + 2; //自定义消息 托盘图标

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;
type
TDUMMYUNIONNAME = record
    case Integer of
      0: (uTimeout: UINT);
      1: (uVersion: UINT);
end;

TNotifyIconData = record
    cbSize: DWORD;
    Wnd: HWND;
    uID: UINT;
    uFlags: UINT;
    uCallbackMessage: UINT;
    hIcon: HICON;
    szTip: array[0..127] of Char;
    dwState: DWORD;
    dwStateMask: DWORD;
    szInfo: array[0..255] of Char;
    DUMMYUNIONNAME: TDUMMYUNIONNAME;
    szInfoTitle: array[0..63] of Char;
    dwInfoFlags: DWORD;
end;

type
TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    PopupMenu1: TPopupMenu;
    yh1: TMenuItem;
    N87pokjpo1: TMenuItem;
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure TrayMessage(var Msg: TMessage); message WM_ICONTRAY;
    procedure Button1Click(Sender: TObject);
private
    { Private declarations }
public
    { Public declarations }
end;

var
Form1: TForm1;
icondata: tnotifyicondata;
TrayIconData: tnotifyicondata;
implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject); //添加托盘区图标
var
mytitle, mytext: string;
begin
TrayIconData.cbSize := SizeOf(TrayIconData);
TrayIconData.uFlags := $10;
mytext := '内容，                   8658587^_^';
strPLCopy(TrayIconData.szInfo, mytext, SizeOf(TrayIconData.szInfo) - 1);
// TrayIconData.DUMMYUNIONNAME.uTimeout := 300; //停留时间
mytitle := 'jin   标题';
strPLCopy(TrayIconData.szInfoTitle, mytitle, SizeOf(TrayIconData.szInfoTitle) - 1);
TrayIconData.dwInfoFlags := NIIF_INFO;   //图标类型
Shell_NotifyIcon(NIM_MODIFY, @TrayIconData);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
with TrayIconData do
begin
    cbSize := SizeOf(TrayIconData);
    Wnd := Handle;
    uID := 0;
    uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
    uCallbackMessage := WM_ICONTRAY;
    hIcon := Application.Icon.Handle;
    szTip := '提示信息！';
end;
Shell_NotifyIcon(NIM_ADD, @TrayIconData);
end;

procedure TForm1.TrayMessage(var Msg: TMessage);
var
p: TPoint;
begin
case Msg.lParam of
    WM_LBUTTONDOWN: //左键
      begin
        ShowMessage('你在图标上面单击了左键');
// MostrarOcultar1.Click;
      end;
    WM_RBUTTONDOWN: //右键
      begin
        SetForegroundWindow(form1.Handle);
        GetCursorPos(p);
        PopUpMenu1.Popup(p.x, p.y);
        PostMessage(form1.Handle, WM_NULL, 0, 0);
      end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE, @TrayIconData); //删除托盘区图标
end;

end.

///////////////////////////////////////////////////////////////////////////////////////////////////

非托盘区气球提示：

uses
   Commctrl;

procedure ShowBalloonTip(Control: TWinControl; Icon: integer; Title: pchar; Text: PWideChar;
BackCL, TextCL: TColor);
const
TOOLTIPS_CLASS = 'tooltips_class32';
TTS_ALWAYSTIP = $01;
TTS_NOPREFIX = $02;
TTS_BALLOON = $40;
TTF_SUBCLASS = $0010;
TTF_TRANSPARENT = $0100;
TTF_CENTERTIP = $0002;
TTM_ADDTOOL = $0400 + 50;
TTM_SETTITLE = (WM_USER + 32);
ICC_WIN95_CLASSES = $000000FF;
type
TOOLINFO = packed record
    cbSize: Integer;
    uFlags: Integer;
    hwnd: THandle;
    uId: Integer;
    rect: TRect;
    hinst: THandle;
    lpszText: PWideChar;
    lParam: Integer;
end;
var
hWndTip: THandle;
ti: TOOLINFO;
hWnd: THandle;
begin
hWnd    := Control.Handle;
hWndTip := CreateWindow(TOOLTIPS_CLASS, nil,
    WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP,
    0, 0, 0, 0, hWnd, 0, HInstance, nil);
if hWndTip <> 0 then
begin
    SetWindowPos(hWndTip, HWND_TOPMOST, 0, 0, 0, 0,
      SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
    ti.cbSize := SizeOf(ti);
    ti.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_SUBCLASS;
    ti.hwnd := hWnd;
    ti.lpszText := Text;
    Windows.GetClientRect(hWnd, ti.rect);
    SendMessage(hWndTip, TTM_SETTIPBKCOLOR, BackCL, 0);
    SendMessage(hWndTip, TTM_SETTIPTEXTCOLOR, TextCL, 0);
    SendMessage(hWndTip, TTM_ADDTOOL, 1, Integer(@ti));
    SendMessage(hWndTip, TTM_SETTITLE, Icon mod 4, Integer(Title));
end;
end;

                     {效果演示}

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowBalloonTip(Button1, 1, '标题', '我在这里！', clBlue, clNavy);
end;