发一个系统托盘程序，大神勿喷
发一个系统托盘程序，大神勿喷。。。小东西，搞着玩的居然不能上传附件，直接上代码{:1_907:}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 于 2016-11-15 19:21 编辑
流云816 发表于 2016-11-14 09:59
上代码不上附件的全是坑啊。
我把代码上传 度盘
链接：http://pan.baidu.com/s/1b7DfWE 密码：c82y
Mike1234567890 发表于 2017-3-18 14:58
好多控件已经实现这个功能了，拿来用就行。JVCL的还是开源的。
对大神来说什么都是浮云 看代码眼花缭乱 好晕那看不懂 第一次知道这个，看下 级别一下子上升了高度，头晕。
可不可以上传百度云再分享外联呢？ 看到代码就头痛 求大神出来科普一下{:301_975:} 学习例子，不错，感谢提供！ 逼格瞬间飙升 从头看到尾，结果是一个也没看懂……
页:
[1]
2