发一个系统托盘程序，大神勿喷

dust88

发一个系统托盘程序，大神勿喷。。。小东西，搞着玩的居然不能上传附件，直接上代码
Unit1.pas:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,ShellAPI, Menus;
const
  Icon_Id=1;//Icon的ID标志
  Mi_IconEvent=Wm_user+1;//自定义Icon事件消息
type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
  private
    { Private declarations }
    NormalIcon,DisabledIcon:TIcon; //正常和失效两种情况的图标
    Status:Boolean;//标志"允许使用"还是"禁止使用"
    procedure InstallIcon;
    procedure ChangeIcon(s:Boolean);
    procedure UnInstallIcon;
    procedure IconOnClick(var message:TMessage);message MI_ICONEVENT;//捕捉自定义消息MI_ICONEVENT的过程IconOnClick的声明
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}
procedure TForm1.ChangeIcon(s:Boolean); //自定义过程ChangeIcon，改变本程序在指示状态栏的图标
var
        IconData:TNotifyIconData;
begin
        IconData.cbSize:=SizeOf(IconData);
        IconData.Wnd:=Handle;
        IconData.uID:=ICON_ID;
        if s=false then //禁止使用
        begin
                IconData.hIcon:=DisabledIcon.Handle;
                Status:=False;
        end
        else //允许使用
        begin
                IconData.hIcon:=Normalicon.Handle;
                Status:=True;
        end;
        IconData.uFlags:=NIF_ICON;
        Shell_NotifyIcon(NIM_MODIFY,@IconData);
end;

procedure TForm1.IconOnClick(var message:TMessage); //处理鼠标在指示状态栏对应的图标上的单击事件
var
        p:TPoint;
begin //如果按下的是鼠标左键，并且允许显示，则显示FORM2
        if((message.lParam=WM_LBUTTONDOWN) and (Status=True)) then
                Form2.Show;
                //如果按下的是鼠标右键，则显示弹出菜单
        if(message.LParam=WM_RBUTTONDOWN) then
        begin
                GetCursorPos(p);
                PopupMenu1.Popup(p.x,p.y);
        end;
end;

procedure TForm1.InstallIcon; //安装图标
var
        IconData:TNotifyIconData;
begin
        NormalIcon:=TIcon.Create;
        DisabledIcon:=TIcon.Create;
        NormalIcon.LoadFromFile('norma1.ico');//允许使用图标
        DisabledIcon.LoadFromFile('norma1.ico');//禁止使用图标
        IconData.cbSize:=SizeOf(IconData);
        IconData.Wnd:=Handle;
        IconData.uID:=ICON_ID;
        IconData.uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP;
        IconData.uCallBackMessage:=MI_ICONEVENT;
        IconData.hIcon:=NormalIcon.Handle;
        IconData.szTip:='这只是一个例子';
        Shell_NotifyIcon(NIM_ADD,@IconData);
end;

procedure TForm1.UnInstallIcon;
var
        IconData:TNotifyIconData;
begin
        IconData.cbSize:=SizeOf(IconData);
        IconData.Wnd:=Handle;
        IconData.uID:=ICON_ID;
        Shell_NotifyIcon(NIM_DELETE,@IconData);
end;





{procedure TForm1.add1Click(Sender:TObject);
begin

end; }

{procedure TForm1.enable1Click(Sender:TObject);
begin
        if (Status=True) then
        begin
                ChangeIcon(false);
        end
        else
        begin
                ChangeIcon(True);
        end;
end; }
procedure TForm1.FormActivate(Sender: TObject);
begin
        Form1.width:=0;
        Form1.Height:=0;
        ShowWindow(Application.Handle,SW_HIDE);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
        UnInstallIcon;
        NormalIcon.Free;
        DisabledIcon.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
        Status:=True;
        InstallIcon;//安装图标
        ChangeIcon(True);//改变图标为normal状态
        ShowWindow(Application.Handle,SW_HIDE);
        SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
end;

procedure TForm1.N1Click(Sender: TObject);
begin
        Form2.Show;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
        if (Status=True) then
        begin
                ChangeIcon(false);
        end
        else
        begin
                ChangeIcon(True);
        end;
end;

end.

Unit2.pas:

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TForm2 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

end.

dust88

流云816 发表于 2016-11-14 09:59
上代码不上附件的全是坑啊。

我把代码上传 度盘
链接：http://pan.baidu.com/s/1b7DfWE 密码：c82y

dust88

Mike1234567890 发表于 2017-3-18 14:58
好多控件已经实现这个功能了，拿来用就行。JVCL的还是开源的。

对大神来说什么都是浮云

lsy691

看代码眼花缭乱

ash19871121

好晕那  看不懂

meng168

第一次知道这个，看下

xualive

级别一下子上升了高度，头晕。
可不可以上传百度云再分享外联呢？

一生一世就好

看到代码  就头痛    求大神出来科普一下

110006600

学习例子，不错，感谢提供！

L丶不悔

逼格瞬间飙升

quifangde

从头看到尾，结果是一个也没看懂……