var tnd:totifyicondata;procedure tform1.myproc(var message:tmessage); begin if message.lparam=wm_lbuttondown then begin shell_notifyicon(nim_delete,@tnd); form1.Show; end;procedure TForm1.FormCreate(Sender: TObject); begin windowproc:=myproc; end;procedure TForm1.Button1Click(Sender: TObject); begin tnd.cbSize:=sizeof(tnd); tnd.Wnd:=self.Handle; tnd.uID:=0; tnd.uFlags:=nif_message or nif_tip or nif_icon; tnd.uCallbackMessage:=wm_traynotify; tnd.hIcon:=application.Icon.Handle; tnd.szTip:='my soft'; shell_notifyicon(nim_add,@tnd); form1.Hide; end;
//以下系统托盘图标 MyTrayIcon.cbSize:=SizeOf(TNotifyIconData); MyTrayIcon.Wnd:=Handle; MyTrayIcon.uId:=1; MyTrayIcon.uFlags:=NIF_ICON or NIF_TIP or NIF_MESSAGE; MyTrayIcon.uCallBackMessage:=WM_MYTRAYICONCALLBACK; MyTrayIcon.hIcon:=Application.Icon.Handle; MyTrayIcon.szTip:='MossLove之天方夜谭'; Shell_NotifyIcon(NIM_ADD,@MyTrayIcon); ******************* //下面继续
//处理点击托盘图标的事件 procedure TFormMoss.WMMyTrayIconCallback(var Msg:TMessage); var CursorPos:TPoint; begin case Msg.LParam of WM_LBUTTONDBLCLK: begin //鼠标左键双击 end; WM_RBUTTONDOWN: begin //单击鼠标右键 end; WM_LBUTTONDOWN: begin //单击鼠标左键 end; end; end; //完了。TNND,一起发还发不出去~~~~~~
application.showmainform:=false;
(未经验证)
怎样只显示在系统栏呢?? 就好比输入法一样只显示在系统栏。?
const
wm_traynotify=wm_user+1234;
procedure myproc(var message:tmessage);
var
tnd:totifyicondata;procedure tform1.myproc(var message:tmessage);
begin
if message.lparam=wm_lbuttondown then
begin
shell_notifyicon(nim_delete,@tnd);
form1.Show;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
windowproc:=myproc;
end;procedure TForm1.Button1Click(Sender: TObject);
begin
tnd.cbSize:=sizeof(tnd);
tnd.Wnd:=self.Handle;
tnd.uID:=0;
tnd.uFlags:=nif_message or nif_tip or nif_icon;
tnd.uCallbackMessage:=wm_traynotify;
tnd.hIcon:=application.Icon.Handle;
tnd.szTip:='my soft';
shell_notifyicon(nim_add,@tnd);
form1.Hide;
end;
*****************
private
//系统托盘图标
MyTrayIcon:TNotifyIconData;
procedure WMMyTrayIconCallback(var Msg:TMessage);
Message WM_MYTRAYICONCALLBACK;
*****************
//注册为服务器进程
const RSP_SIMPLE_SERVICE=1;
function RegisterServiceProcess (dwProcessID, dwType: DWord) : DWord; stdcall; external 'KERNEL32.DLL';
****************
//OnFormCreat
RegisterServiceProcess(GetCurrentProcessID,RSP_SIMPLE_SERVICE); //Alt+Ctrl+Del 不能显示程序
SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW); //不显示在任务栏
Application.ShowMainForm:=flase;
//下面继续
MyTrayIcon.cbSize:=SizeOf(TNotifyIconData);
MyTrayIcon.Wnd:=Handle;
MyTrayIcon.uId:=1;
MyTrayIcon.uFlags:=NIF_ICON or NIF_TIP or NIF_MESSAGE;
MyTrayIcon.uCallBackMessage:=WM_MYTRAYICONCALLBACK;
MyTrayIcon.hIcon:=Application.Icon.Handle;
MyTrayIcon.szTip:='MossLove之天方夜谭';
Shell_NotifyIcon(NIM_ADD,@MyTrayIcon);
*******************
//下面继续
procedure TFormMoss.WMMyTrayIconCallback(var Msg:TMessage);
var CursorPos:TPoint;
begin
case Msg.LParam of
WM_LBUTTONDBLCLK: begin //鼠标左键双击 end;
WM_RBUTTONDOWN: begin //单击鼠标右键 end;
WM_LBUTTONDOWN: begin //单击鼠标左键 end;
end;
end;
//完了。TNND,一起发还发不出去~~~~~~