unit NotifyIcon;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ShellApi,ExtCtrls,Menus;
const
WM_MY_Notify=WM_USER+100;
type
TPopupStyle=Set of (Left_Click,Right_Click,Left_DbClick,Right_DbClick);
TWhoButton=(B_Left,B_Right);
TMouseEvent=procedure(Sender:TObject;x,y:Word;WhoButton:TWhoButton) of Object;
//---------class TNotifyIcon---------
TNotifyIcon = class(TCustomControl)
private
{ Private declarations }
FIcon:TIcon;
FPda
NOTIFYICONDATA;
FTitle:string;
FIconVisible:boolean;
FPopupMenu:TPopupMenu;
FPopupStyle:TPopupStyle;
FOnIconMouseDown:TMouseEvent;
FOnIconDoubleClick:TMouseEvent;
procedure SetIcon(Icon:TICON);
procedure SetTitle(NewTitle:string);
function IsShowing:boolean;
procedure ShowIt(Accept:boolean);
procedure NotifyIconClick(var msg : TMessage);
Message WM_My_Notify;
protected
{ Protected declarations }
public
{ Public declarations }
property IsVisible:boolean read IsShowing write ShowIt;
constructor Create(AOwner: TComponent); override;
procedure ShowIcon;
procedure HideIcon;
destructor Destroy; override;
procedure ModifyIcon(NewIcon:TIcon);
procedure Paint;override;
published
{ Published declarations }
property Height default 33;
property Width default 33;
property NotifyIcon:TIcon read FIcon write SetIcon;
property Title:string read FTitle write SetTitle ;
property OnIconDoubleClick:TMouseEvent
read FOnIconDoubleClick write FOnIconDoubleClick;
property OnIconMouseDown:TMouseEvent
read FOnIconMouseDown write FOnIconMouseDown;
property PopupMenu:TPopupMenu read FPopupMenu write FPopupMenu;
property PopupStyle:TPopupStyle read FPopupStyle
write FPopupStyle default [];
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('MyControl', [TNotifyIcon]);
end;
procedure TNotifyIcon.ShowIt(Accept:boolean);
begin
if Accept=true then ShowIcon
else HideIcon;
end;
procedure TNotifyIcon.Paint;
begin
if (csDesigning in ComponentState) then begin
Width:=33;
Height:=33;
With Canvas do begin
Brush.Color:=clInfoBk;
Ellipse(0,0,Self.Width,Self.Height);
Font.Color:=clBlue;
Brush.Style:=bsClear;
FloodFill(5,5,clInfoBk,fsBorder);
Brush.Color:=clInfoBk;
TextOut(3,Self.Height div 2-6,'Notify');
end
end;
end;
procedure TNotifyIcon.NotifyIconClick(var msg : TMessage);
var p:TPoint;
begin
try
case msg.LParam of
WM_LBUTTONDOWN: begin
GetCursorPos(p);
if Left_Click in FPopupStyle then begin
SetForegroundWindow(ParentWindow);
FPopupMenu.Popup(p.x,p.y);
end;
if Assigned(FOnIconMouseDown) then begin
FOnIconMouseDown(Self,p.x,p.y,b_Left);
end;
end;
WM_RBUTTONDOWN: begin
GetCursorPos(p);
if Right_Click in FPopupStyle then begin
SetForegroundWindow(ParentWindow);
FPopupMenu.Popup(p.x,p.y);
end;
if Assigned(FOnIconMouseDown) then begin
FOnIconMouseDown(Self,p.x,p.y,b_Right);
end;
end;
WM_LBUTTONDBLCLK: begin
GetCursorPos(p);
if Left_DbClick in FPopupStyle then begin
SetForegroundWindow(ParentWindow);
FPopupMenu.Popup(p.x,p.y);
end;
if Assigned(FOnIconDoubleClick) then begin
FOnIconDoubleClick(Self,p.x,p.y,b_Left);
end;
end;
WM_RBUTTONDBLCLk: begin
GetCursorPos(p);
if Right_Click in FPopupStyle then begin
SetForegroundWindow(ParentWindow);
FPopupMenu.Popup(p.x,p.y);
end;
if Assigned(FOnIconDoubleClick) then begin
FOnIconDoubleClick(Self,p.x,p.y,b_Right);
end;
end;
end;
except
end;
end;
function MAKELANGID(p, s:word):Cardinal;
begin
result:= (((s)shl 10) or(p));
end;
constructor TNotifyIcon.Create(AOwner: TComponent);
begin
try
inherited Create(AOwner);
FIcon:=TIcon.Create;
Height:=36;
Width:=36;
Visible:=false;
FTitle:='Welcome';
FIconVisible:=false;
//-------------set tray info---------
ParentWindow:=TWinControl(AOwner).Handle;
New(Fpda);
With FPda^ do begin
uCallbackMessage:=WM_MY_Notify;
cbsize:=SizeOf(FPda^);
uID:=200;
wnd:=Handle;
uFlags:=NIF_ICON+NIF_Tip+NIF_MESSAGE;
end;
end;
except
ShowMessage('TNotifyIcon Create error');
end;
end;
procedure TNotifyIcon.SetIcon(Icon:TICON);
begin
FIcon.Assign(Icon);
end;
procedure TNotifyIcon.ShowIcon;
begin
try
if FIcon.Handle=0 then
begin
Exit;
end;
if FIcon.Handle<>FPda^.hIcon then
HideIcon;
if FIconVisible=false then
begin
FPda^.hIcon:=FIcon.handle;
FIconVisible:=true;
Shell_NotifyIcon(NiM_ADD,FPda);
end;
except
ShowMessage('TNotifyIcon Show Error ');
end;
end;
procedure TNotifyIcon.HideIcon;
begin
try
if FIconVisible then
begin
FIconVisible:=false;
Shell_NotifyIcon(NiM_DELETE,FPda);
end;
except
ShowMessage('TNotifyIcon Hide Error');
end;
end;
procedure TNotifyIcon.SetTitle(NewTitle:string);
begin
FTitle:=NewTitle;
StrCopy(FPda^.szTip,PChar(FTitle));
if FIconVisible then
begin
HideIcon;
ShowIcon;
end;
end;
destructor TNotifyIcon.Destroy;
begin
try
HideIcon;
Dispose(FPda);
FIcon.Free;
inherited Destroy;
except
ShowMessage('TNotifyIcon Destroy Error');
end;
end;
procedure TNotifyIcon.ModifyIcon(NewIcon:TIcon);
begin
try
SetIcon(NewIcon);
FPda^.hIcon:=FIcon.handle;
if FIconVisible then
Shell_NotifyIcon(NiM_Modify,FPda);
except
ShowMessage('TNotifyIcon Modify Error');
end;
end;
function TNotifyIcon.IsShowing:boolean;
begin
Result:=FIconVisible;
end;
end.
