unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus,shellapi, ExtCtrls;
const
ICON_ID = 1; // 图标在本应用程序中的编号
MI_ICONEVENT = WM_USER + 1; // 图标上的鼠标事件
type
TForm1 = class(TForm)
pop1: TPopupMenu; // 在图标上右点鼠标时弹出的菜单
status1: TMenuItem; // pop1菜单的第一项,选取它会改变程序的状态
close1: TMenuItem;
Timer1: TTimer; // pop1菜单的最后一项,它会关闭此应用程序
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure close1Click(Sender: TObject);
procedure status1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
normalicon, disabledicon: TIcon; //需放在状态指示区的图标
status: Boolean;
procedure InstallIcon; //在状态指示区上安装图标
procedure ChangeIcon(status:Boolean);//根据参数,显示不同的图标
procedure UnInstallIcon; //卸载图标
procedure IconOnClick(var message: TMessage); message MI_ICONEVENT; //响应图标上的鼠标事件
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
InstallIcon;
ChangeIcon(False );
ShowWindow(Application.Handle, SW_HIDE ); //隐藏应用程序主窗口机
end;
procedure TForm1.InstallIcon;
var IconData: TNotifyIconData;
begin
normalicon := TIcon.Create;
disabledicon := TIcon.Create;
normalicon.LoadFromFile( 'normal.ico' );
disabledicon.LoadFromFile( '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.ChangeIcon( status: boolean );
var IconData: TNotifyIconData;
begin
IconData.cbSize := SizeOf(IconData);
IconData.wnd := Handle;
IconData.uID := ICON_ID;
if status then IconData.hIcon := normalicon.Handle else IconData.hIcon :=
disabledIcon.Handle;
IconData.uFlags := NIF_ICON;
Shell_NotifyIcon(NIM_MODIFY, @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.IconOnClick( var message: Tmessage);
var p : TPoint;
begin
if (message.lParam = WM_LBUTTONDOWN) then
ShowWindow( Application.Handle, SW_SHOW );
if (message.lParam = WM_RBUTTONDOWN) then begin
GetCursorPos( p );
pop1.Popup( p.x ,p.y );
ChangeIcon( status );
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
UnInstallIcon;
normalicon.Free;
disabledicon.Free;
end;
procedure TForm1.close1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.status1Click(Sender: TObject);
begin
status := not status;
if status then status1.Caption := 'Enable'
else status1.Caption := 'Disable';
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
status:=not status;
ChangeIcon( status );
end;
end.
object Form1: TForm1
Left = 215
Top = 156
Width = 129
Height = 116
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object pop1: TPopupMenu
Left = 32
Top = 32
object status1: TMenuItem
Caption = 'ChangeIcon'
Checked = True
OnClick = status1Click
end
object close1: TMenuItem
Caption = 'Exit'
OnClick = close1Click
end
end
object Timer1: TTimer
Interval = 500
OnTimer = Timer1Timer
Left = 32
Top = 4
end
end