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; //自定义消息 托盘图标
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;
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;
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;
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
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;
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;
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;
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;
begin
Shell_NotifyIcon(NIM_DELETE, @TrayIconData); //删除托盘区图标
end;
end.
///
非托盘区气球提示:
uses
Commctrl;
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;
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;
begin
ShowBalloonTip(Button1, 1, '标题', '我在这里!', clBlue, clNavy);
end;
转载于:https://blog.51cto.com/wesoho/274769