给你个例子,建两个窗口,unit1.pas unit2.pas,找两个图标文件normal.ico,disable.ico
放在同一目录下:
unit1.pas
-------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, shellapi; //添加shellapi单元
const
ICON_ID = 1; //为图标和消息定义两个常量
MI_ICONEVENT = WM_USER+1;
type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
Appitem: TMenuItem;
EnableOrDisable: TMenuItem;
ExitItem: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormActivate(Sender: TObject);
procedure AppitemClick(Sender: TObject);
procedure EnableOrDisableClick(Sender: TObject);
procedure ExitItemClick(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;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses unit2; //引用窗体2
{$R *.dfm}
procedure TForm1.ChangeIcon(s: Boolean);
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;
AppItem.Enabled := False ;
end
else // 允许使用
begin
IconData.hIcon := Normalicon.handle;
status := true;
AppItem.Enabled := 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( 'E:/!我的资料/我的作品/#MyDelphi/操作任务栏/normal.ico' ); // 允许使用状态下的图标
DisabledIcon.LoadFromFile( 'E:/!我的资料/我的作品/#MyDelphi/操作任务栏/disable.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.FormCreate(Sender: TObject);
begin
//安装图标并隐藏主窗体
Status := True;
InstallIcon;
ChangeIcon( True );
ShowWindow( Application.Handle, SW_HIDE );
SetWindowLong( Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// 卸载图标并释放图标资源
UnInstallIcon;
NormalIcon.Free;
DisabledIcon.Free;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
// 隐藏Form1
Form1.width := 0;
Form1.Height := 0;
ShowWindow( Application.Handle, SW_HIDE);
end;
procedure TForm1.AppitemClick(Sender: TObject);
begin
Form2.show;
end;
procedure TForm1.EnableOrDisableClick(Sender: TObject);
begin
if (Status = True) then
begin
changeIcon( False );
EnableOrDisable.Caption := '允许使用[&Y]';
end
else
begin
ChangeIcon( True );
EnableOrDisable.Caption := '禁止使用[&D]';
end;
end;
procedure TForm1.ExitItemClick(Sender: TObject);
begin
Close;
end;
end.
---------
unit2.pas
--------------------
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus;
type
TForm2 = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
procedure N1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.N1Click(Sender: TObject);
begin
Close;
end;
end.