delphi(api)系统托盘

来源：互联网发布：前端怎么连接数据库编辑：程序博客网时间：2024/06/01 14:24

好简单的一个事例啊，昨天翻下上去几年的资料，找到的这个。

//delphi用API制作的系统托盘加弹出菜单，用了将近两年的。NET再看下这个有点感觉不同

//也是以前开发时常用的这种方法
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,shellapi, StdCtrls, Menus;
  const wm_icon = WM_USER + 100;
type
  TForm1 = class(TForm)
  Button2: TButton;
  procedure Button2Click(Sender: TObject);
  procedure  user_sysmenu(var msg:twmmenuselect);  message WM_COMMAND;
  private
    { Private declarations }
  procedure OnIconNotify(var Message: TMessage); message wm_icon;
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
  implementation
{$R *.dfm}
     procedure  tform1.user_sysmenu(var msg:twmmenuselect);//处理弹出菜单的选择项
     begin
     if msg.IDItem =999 then
      self.Close
     else
      inherited;
     end;
procedure tform1.OnIconNotify(var Message: TMessage);  //处理程序提示区图标消息
   var
      menu:HMENU;
       rect:trect;
       pp:tpoint;
   begin
if Message.LParam =WM_RBUTTONDOWN  then
    begin
  rect.Left:=56;
rect.Top:=0;
rect.Right:=100;
rect.Bottom:=88;
//rect.BottomRight:= point(LOWORD(message.lParam),HIWORD(message.lParam));
menu:=createpopupmenu();
appendmenu(menu,MF_STRING,999,'exit');
GetCursorPos ( pp);//current mouse postion
TrackPopupMenu(menu, TPM_LEFTALIGN  , pp.x  ,  pp.y  ,0,self.Handle,@rect);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
cc:TNotifyIconData ;
begin
cc.cbSize:= sizeof(cc);
cc.Wnd:= self.Handle;
cc.uID :=  1;
cc.hIcon := Application.Icon.Handle; // 窗口句柄
cc.szTip := 'This is a test application'   ;
cc.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE; // 指明哪些字段有效
cc.uCallbackMessage:= wm_icon   ; //处理的消息
Shell_NotifyIcon(NIM_ADD, @cc);   // destroy window  NIM_DELETE  + index
end;

end.