小弟写了个托盘程序 但就是不好使。请各位高手帮忙看看那里错了！如有原代码，更好！
所用控件：一个button ,image, PopupMenu
unit Unit1;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Menus, StdCtrls,shellapi;
const
mymsg = wm_user + 1;
iid = 100;
type
TForm1 = class(TForm)
Button1: TButton;
PopupMenu1: TPopupMenu;
Image1: TImage;
N11: TMenuItem;
N21: TMenuItem;
N31: TMenuItem;
procedure Button1Click(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure N21Click(Sender: TObject);
private
procedure mymessage(var message:tmessage); { Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;
ntid: TnotifyIconDataA;
implementation{$R *.dfm}
TYPe
TnotifyIconDataA = record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: ARRAY[0..63] of AnsiChar;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ntid.cbsize := sizeof(TnotifyIconDataA);
ntid.Wnd := Handle;
ntid.uID := iid;
ntid.uFlags := NIF_ICON + NIF_TIP + NIF_MESSAGE;
ntid.uCallbackMessage := mymsg;
ntid.hIcon := image1.Picture.Icon.Handle;
ntid.szTip := 'asdf';
shell_notifyicona(NIM_ADD,@ntid); self.Visible := false;end;procedure TForm1.mymessage(var message: tmessage);
var
mypt:Tpoint;
begin
Inherited;
if message.LParam = WM_RBUTTONUP then
begin
getCursorPos(mypt);
PopupMenu1.Popup(mypt.X, mypt.Y);
end;
message.Result:= 0;end;procedure TForm1.N11Click(Sender: TObject);
begin
close;
end;procedure TForm1.N21Click(Sender: TObject);
begin
ntid.cbSize := sizeof(TnotifyIconDataA);
ntid.Wnd := Handle;
ntid.uID := iid;
ntid.uFlags := NIF_ICON + NIF_TIP + NIF_MESSAGE;
ntid.uCallbackMessage := mymsg;
ntid.hIcon := image1.Picture.Icon.Handle;
ntid.szTip := '在这里';
shell_notifyicona(NIM_DELETE,@ntid);
self.Visible := true;end;end.
所用控件：一个button ,image, PopupMenu
unit Unit1;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Menus, StdCtrls,shellapi;
const
mymsg = wm_user + 1;
iid = 100;
type
TForm1 = class(TForm)
Button1: TButton;
PopupMenu1: TPopupMenu;
Image1: TImage;
N11: TMenuItem;
N21: TMenuItem;
N31: TMenuItem;
procedure Button1Click(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure N21Click(Sender: TObject);
private
procedure mymessage(var message:tmessage); { Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;
ntid: TnotifyIconDataA;
implementation{$R *.dfm}
TYPe
TnotifyIconDataA = record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: ARRAY[0..63] of AnsiChar;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ntid.cbsize := sizeof(TnotifyIconDataA);
ntid.Wnd := Handle;
ntid.uID := iid;
ntid.uFlags := NIF_ICON + NIF_TIP + NIF_MESSAGE;
ntid.uCallbackMessage := mymsg;
ntid.hIcon := image1.Picture.Icon.Handle;
ntid.szTip := 'asdf';
shell_notifyicona(NIM_ADD,@ntid); self.Visible := false;end;procedure TForm1.mymessage(var message: tmessage);
var
mypt:Tpoint;
begin
Inherited;
if message.LParam = WM_RBUTTONUP then
begin
getCursorPos(mypt);
PopupMenu1.Popup(mypt.X, mypt.Y);
end;
message.Result:= 0;end;procedure TForm1.N11Click(Sender: TObject);
begin
close;
end;procedure TForm1.N21Click(Sender: TObject);
begin
ntid.cbSize := sizeof(TnotifyIconDataA);
ntid.Wnd := Handle;
ntid.uID := iid;
ntid.uFlags := NIF_ICON + NIF_TIP + NIF_MESSAGE;
ntid.uCallbackMessage := mymsg;
ntid.hIcon := image1.Picture.Icon.Handle;
ntid.szTip := '在这里';
shell_notifyicona(NIM_DELETE,@ntid);
self.Visible := true;end;end.
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ShellApi, Menus;const //消息常量（用来取代宏）
WM_TrayMessage=WM_User+100;type
TForm1 = class(TForm)
CheckBox1: TCheckBox;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
hello1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
procedure CheckBox1Click(Sender: TObject);
//系统消息
procedure WMTrayMessage(var msg:TMessage);message WM_TrayMessage;
procedure FormClose(Sender: TObject; var Action: TCloseAction); private
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;
implementation{$R *.dfm}procedure TForm1.WMTrayMessage(var msg:TMessage);
var
p:TPoint;
begin
if msg.LParam = WM_LButtonDown then
begin
messagedlg('您在任务栏图标上按下了左键！',mtInformation,[mbOK],0);
end
else if msg.LParam=WM_RButtonDown then
begin
GetCursorPos(p); //取光标位置
PopupMenu1.Popup(p.X,p.Y); //弹出菜单
end;
end;procedure TForm1.CheckBox1Click(Sender: TObject);
var
nid:TNotifyIconData;
begin
nid.cbSize:=SizeOf(TNotifyIconData);
nid.hIcon:=Application.Icon.Handle;
nid.szTip:='欢迎使用任务栏图标';
nid.uCallbackMessage:=WM_TrayMessage;
nid.uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP;
nid.uID:=0;
nid.Wnd:=Handle;
if checkbox1.Checked then
begin
Shell_NotifyIcon(NIM_ADD,@NID)
end else
begin
Shell_NotifyIcon(NIM_ADD,@NID);
end;end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
checkbox1.Checked:=False;
end;end.
unit Unit1;interface
uses
Windows, Messages, SysUtils,
Classes, Graphics, Controls, Forms,
Dialogs,ShellAPI;
const
WM_BARICON=WM_USER+200;
type
TForm1 = class(TForm)
private
procedure WMSysCommand(var Message: TMessage); message WM_SYSCOMMAND;
//窗体状态相关
procedure WMBarIcon(var Message:TMessage);message WM_BARICON;
//托盘相关
procedure WMEXITSIZEMOVE(var Message: TMessage);message WM_EXITSIZEMOVE;
//窗体大小相关
procedure WMNCMOUSEMOVE(var Message: TMessage);message WM_NCMOUSEMOVE;
//鼠标消息，不在焦点也可以
public
end;var
Form1: TForm1;implementation{$R *.dfm}
{----------------------------------------------------- SC_CLOSE 关闭窗体
SC_CONTEXTHELP Changes the cursor to a question with a pointer. If the user then clicks a control in the dialog box, the control receives a WM_HELP message.
SC_DEFAULT Selects the default item; the user double-clicked the System menu.
SC_HOTKEY Activates the window associated with the application-specified hot key. The low-order word of lParam identifies the window to activate.
SC_HSCROLL Scrolls horizontally.
SC_KEYMENU Retrieves the System menu as a result of a keystroke.
SC_MAXIMIZE (or SC_ZOOM) Maximizes the window.
SC_MINIMIZE (or SC_ICON) Minimizes the window.
SC_MONITORPOWER Windows 95 only: Sets the state of the display. This command supports devices that have power-saving features, such as a battery-powered personal computer.
SC_MOUSEMENU Retrieves the System menu as a result of a mouse click.
SC_MOVE Moves the window.
SC_NEXTWINDOW Moves to the next window.
SC_PREVWINDOW Moves to the previous window.
SC_RESTORE Restores the window to its normal position and size.
SC_SCREENSAVE Executes the screen saver application specified in the [boot] section of the SYSTEM.INI file.
SC_SIZE Sizes the window.
SC_TASKLIST Executes or activates Windows Task Manager.
SC_VSCROLL Scrolls vertically. -----------------------------------------------------
function Shell_NotifyIcon(dwMessage:DWORD; lpData: PNotifyIconData): BOOL; stdcall;
其中的参数dwMessage指定Shell_NotifyIcon函数的操作,
可以是NIM_ADD NIM_DELETE NIM_MODIFY三个值中的一个,
分别对应添加图标、删除图标、修改图标的动作
-----------------------------------------------------
PNotifyIconData结构的定义如下:_NOTIFYICONDATAW = record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array [0..63] of WideChar;
end;
TNotifyIconData = _NOTIFYICONDATAW;
-----------------------------------------------------}
procedure TForm1.WMSysCommand(var Message:TMessage);
var
lpData:PNotifyIconData;
begin
if Message.WParam = SC_ICON then //SC_ICON是最小化
begin
//如果用户最小化窗口则将窗口隐藏并在任务栏上添加图标
lpData := new(PNotifyIconDataA);
// lpData.cbSize := 88;//SizeOf(PNotifyIconDataA);
lpData.Wnd := Form1.Handle;//form1的句柄
lpData.hIcon := Form1.Icon.Handle;//要添加图标的句柄
lpData.uCallbackMessage := WM_BARICON;//当用户对任务栏图标有动作时，统都会发送WM_BARICON消息给 Form1.Handle指定的窗口
lpData.uID :=0;
lpData.szTip := '测试程序'; //移动到托盘出现的汉字
lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
Shell_NotifyIcon(NIM_ADD,lpData);
dispose(lpData);
Form1.Visible := False;
end
else
//如果是其它的SystemCommand消息则调用系统缺省处理函数处理之。
DefWindowProc(Form1.Handle,Message.Msg,Message.WParam,Message.LParam);
end;
{--------------------------------------------------------}
procedure TForm1.WMBarIcon(var Message:TMessage);
var
lpData:PNotifyIconData;
begin
if (Message.LParam = WM_LBUTTONDOWN) then //WM_LBUTTONDOWN是按下鼠标左键的消息
begin
//如果用户点击任务栏图标则将图标删除并回复窗口。
lpData := new(PNotifyIconDataA);
// lpData.cbSize := 88;//SizeOf(PNotifyIconDataA);
lpData.Wnd := Form1.Handle;
lpData.hIcon := Form1.Icon.Handle;
lpData.uCallbackMessage := WM_BARICON;
lpData.uID :=0;
lpData.szTip := '测试程序';
lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
Shell_NotifyIcon(NIM_DELETE ,lpData);
dispose(lpData);
Form1.Visible := True;
end;
end;
{--------------------------------------------------------}
procedure TForm1.WMEXITSIZEMOVE(var Message: TMessage);
begin
Form1.Caption := '你已经调整完毕窗体大小';
end;
{--------------------------------------------------------}
procedure TForm1.WMNCMOUSEMOVE(var Message: TMessage);
var
s : string;
begin
case Message.wParam of
HTERROR : s := 'HTERROR';
HTTRANSPARENT : s := 'HTTRANSPARENT';
HTNOWHERE : s := 'HTNOWHERE';
HTCLIENT : s := 'HTCLIENT';
HTCAPTION : s := 'HTCAPTION';
HTSYSMENU : s := 'HTSYSMENU';
HTSIZE : s := 'HTSIZE';
HTMENU : s := 'HTMENU';
HTHSCROLL : s := 'HTHSCROLL';
HTVSCROLL : s := 'HTVSCROLL';
HTMINBUTTON : s := 'HTMINBUTTON';
HTMAXBUTTON : s := 'HTMAXBUTTON';
HTLEFT : s := 'HTLEFT';
HTRIGHT : s := 'HTRIGHT';
HTTOP : s := 'HTTOP';
HTTOPLEFT : s := 'HTTOPLEFT';
HTTOPRIGHT : s := 'HTTOPRIGHT';
HTBOTTOM : s := 'HTBOTTOM';
HTBOTTOMLEFT : s := 'HTBOTTOMLEFT';
HTBOTTOMRIGHT : s := 'HTBOTTOMRIGHT';
HTBORDER : s := 'HTBORDER';
HTOBJECT : s := 'HTOBJECT';
HTCLOSE : s := 'HTCLOSE';
HTHELP : s := 'HTHELP';
else s := '';
end;
Form1.Caption := s;
Message.Result := 0;
end;
end.
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,shellapi, Menus, AppEvnts,Registry;
const
mousemsg = wm_user + 1; //自定义消息，用于处理用户在图标上点击鼠标的事件
iid = 100; //用户自定义数值，在TnotifyIconDataA类型全局变量ntida中使用
type
TForm1 = class(TForm)
Button1: TButton;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
ApplicationEvents1: TApplicationEvents;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure ApplicationEvents1Minimize(Sender: TObject);
procedure FormShow(Sender: TObject);
private
procedure mousemessage(var message: tmessage); message mousemsg;
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;
ntida:TNotifyIcondataA; //用于增加和删除系统状态图标
implementation{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);
begin
ntida.cbSize := sizeof(tnotifyicondataa); //指定ntida的长度
ntida.Wnd := handle; //取应用程序主窗体的句柄
ntida.uID := iid; //用户自定义的一个数值，在uCallbackMessage参数指定的消息中使
ntida.uFlags := nif_icon + nif_tip +
nif_message; //指定在该结构中uCallbackMessage、hIcon和szTip参数都有效
ntida.uCallbackMessage := mousemsg;
//指定的窗口消息
// ntida.hIcon := Application.Icon.handle;
//指定系统状态栏显示应用程序的图标句柄
ntida.szTip := 'Icon';
//当鼠标停留在系统状态栏该图标上时，出现该提示信息
shell_notifyicona(NIM_ADD, @ntida);
//在系统状态栏增加一个新图标
end;
procedure TForm1.mousemessage(var message: tmessage);
var
mousept: TPoint; //鼠标点击位置
begin
inherited;
if message.LParam = wm_rbuttonup then begin //用鼠标右键点击图标
getcursorpos(mousept); //获取光标位置
popupmenu1.popup(mousept.x, mousept.y);
//在光标位置弹出选单
end;
if message.LParam = wm_lbuttonup then begin //用鼠标左键点击图标
{ //显示应用程序窗口
ShowWindow(Handle, SW_SHOW);
//在任务栏上显示应用程序窗口
ShowWindow(Application.handle, SW_SHOW);
SetWindowLong(Application.Handle, GWL_EXSTYLE,
not (GetWindowLong(Application.handle, GWL_EXSTYLE)
or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW)); }
end;
message.Result := 0;
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caNone; //不对窗体进行任何操作
ShowWindow(Handle, SW_HIDE); //隐藏主窗体
//隐藏应用程序窗口在任务栏上的显示
ShowWindow(Application.Handle, SW_HIDE);
SetWindowLong(Application.Handle, GWL_EXSTYLE,
not (GetWindowLong(Application.handle, GWL_EXSTYLE)
or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW));
end;procedure TForm1.Button1Click(Sender: TObject);
begin
ntida.cbSize := sizeof(tnotifyicondataa);
ntida.wnd := handle;
ntida.uID := iid;
ntida.uFlags := nif_icon + nif_tip + nif_message;
ntida.uCallbackMessage := mousemsg;
ntida.hIcon := Application.Icon.handle;
ntida.szTip := 'Icon';
shell_notifyicona(NIM_DELETE, @ntida);
//删除已有的应用程序图标
Application.Terminate;
//中断应用程序运行，退出应用程序
end;end.
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,shellapi, Menus;
const
WM_TrayMessage=WM_User+100;
type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
N11: TMenuItem;
N21: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
protected
procedure AppMinimized(Sender: TObject);
procedure WMTrayMessage(var msg:TMessage);message WM_TrayMessage;
private
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;
NID:TNotifyIconData;
implementation{$R *.dfm}
procedure TForm1.AppMinimized(Sender: TObject);
begin
NID.cbSize:=SizeOf(TNotifyIconData);
NID.hIcon:=Application.Icon.Handle;
NID.szTip:= '托盘 ';
NID.uCallbackMessage:=WM_TrayMessage;
NID.uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP;
NID.uID:=0;
NID.Wnd:=Handle;
Shell_NotifyIcon(NIM_ADD,@NID);
ShowWindow(Application.Handle,SW_Hide);
end;
procedure TForm1.WMTrayMessage(var msg: TMessage);
var
p:TPoint;
begin
if msg.LParam=WM_LButtonDown then
begin
ShowWindow(Application.Handle,SW_Show);
Application.Restore;
end
else if msg.LParam=WM_RButtonDown then
begin
GetCursorPos(p);
PopupMenu1.Popup(p.x,p.y);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMinimize:=AppMinimized;
AppMinimized(nil);
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE,@NID);
end;end.