delphi制作的托盘程序
2006-02-04 13:54:58 来源:WEB开发网unit uMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, shellapi,
Menus, Buttons, ExtCtrls;
const
mousemsg = wm_user + 1;
iid = 100;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
Panel1: TPanel;
SpeedButton1: TSpeedButton;
SpeedButton6: TSpeedButton;
SpeedButton7: TSpeedButton;
SpeedButton8: TSpeedButton;
SpeedButton9: TSpeedButton;
SpeedButton10: TSpeedButton;
PopupMenu1: TPopupMenu;
exit1: TMenuItem;
SpeedButton2: TSpeedButton;
PRocedure SQLLMClick(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure exit1Click(Sender: TObject);
private
{ Private declarations }
procedure mousemessage(var message: tmessage); message
mousemsg;
public
{ Public declarations }
procedure exec(sender: tobject);
end;
var
Form1: TForm1;
ntida: TNotifyIcondataA;
implementation
{$R *.DFM}
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.FormCreate(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_ADD, @ntida);
end;
procedure TForm1.exit1Click(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.
更多精彩
赞助商链接