unit TrayIcon;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Menus, ShellAPI;type
ENotifyIconError = class(Exception);
TTrayNotifyIcon = class(TComponent)
private
{ Private declarations }
FDefaultIcon : THandle;
FIcon : TIcon;
FHideTask : Boolean;
FHint : string;
FIconVisible : Boolean;
FPopupMenu : TPopupMenu;
FOnClick : TNotifyEvent;
FOnDblClick : TNotifyEvent;
FNoShowClick : Boolean;
FTimer : TTimer;
Tnd : TNotifyIconData;
procedure SetIcon(Value : TIcon);
procedure SetHideTask(Value : Boolean);
procedure SetHint(Value : string);
procedure SetIconVisible(Value : Boolean);
procedure SetPopupMenu(Value : TPopupMenu);
procedure SendTrayMessage(Msg : DWORD; Flags : UINT);
function ActiveIconHandle : THandle;
procedure OnButtonTimer(Sender : TObject);
protected
{ Protected declarations }
procedure Loaded; override;
procedure LoadDefaultIcon; virtual;
procedure Notification(AComponent : TComponent; Operation : TOperation); override;
public
{ Public declarations }
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property Icon : TIcon read FIcon write SetIcon;
property HideTask : Boolean read FHideTask write SetHideTask default False;
property Hint : string read FHint write SetHint;
property IconVisible : Boolean read FIconVisible write SetIconVisible default False;
property PopupMenu : TPopupMenu read FPopupMenu write SetPopupMenu;
property OnClick : TNotifyEvent read FOnClick write FOnClick;
property OnDblClick : TNotifyEvent read FOnDblClick write FOnDblClick;
end;procedure Register;implementationprocedure Register;
begin
RegisterComponents('MICHAEL', [TTrayNotifyIcon]);
end;{TIconManager}Type
TIconManager = class
private
FHWindow : HWnd;
procedure TrayWndProc(var Message : TMessage);
public
constructor Create;
destructor Destroy; override;
property HWindow : HWnd read FHWindow write FHWindow;
end;var
IconMgr : TIconManager;
DDGM_TRAYICON : Integer;constructor TIconManager.Create;
begin
FHWindow := AllocateHWnd(TrayWndProc);
end;destructor TIconManager.Destroy;
begin
if FHWindow <> 0 then DeallocateHWnd(FHWindow);
inherited Destroy;
end;procedure TIconManager.TrayWndProc(var Message : TMessage);
var
pt : TPoint;
TheIcon : TTrayNotifyIcon;
begin
with Message do
begin
if (Msg = DDGM_TRAYICON) then
begin
TheIcon := TTrayNotifyIcon(WParam);
case lParam of
WM_LBUTTONDOWN : TheIcon.FTimer.Enabled := True;
WM_LBUTTONDBLCLK :
begin
TheIcon.FNoShowClick := True;
if Assigned(TheIcon.FOnDblClick) then TheIcon.FOnDblClick(self);
end;
WM_RBUTTONDOWN :
begin
if Assigned(TheIcon.FPopupMenu) then
begin
SetForegroundWindow(IconMgr.HWindow);
GetCursorPos(Pt);
TheIcon.FPopupMenu.Popup(Pt.X, Pt.Y);
PostMessage(IconMgr.HWindow, WM_USER, 0, 0);
end;
end;
end;
end
else
Result := DefWindowProc(FHWindow, Msg, wParam, lParam);
end;
end;{TTrayNotifyIcon}
constructor TTrayNotifyIcon.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FIcon := TIcon.Create;
FTimer := TTimer.Create(self);
with FTimer do
begin
Enabled := False;
Interval := GetDoubleClickTime;
OnTimer := OnButtonTimer;
end;
LoadDefaultIcon;
end;destructor TTrayNotifyIcon.Destroy;
begin
if FIconVisible then SetIConVisible(False);
FIcon.Free;
FTimer.Free;
inherited Destroy;
end;function TTrayNotifyIcon.ActiveIconHandle : THandle;
begin
if (FIcon.Handle <> 0) then
Result := FIcon.Handle
else
Result := FDefaultIcon;end;procedure TTrayNotifyIcon.LoadDefaultIcon;
begin
FDefaultIcon := LoadIcon(0, IDI_WINLOGO);
end;procedure TTrayNotifyIcon.Loaded;
begin
inherited Loaded;
if FIconVisible then
SendTrayMessage(NIM_ADD, NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;procedure TTrayNotifyIcon.Notification(AComponent : TComponent; Operation : TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = PopupMenu) then
PopupMenu := nil;
end;procedure TTrayNotifyIcon.OnButtonTimer(Sender : TObject);
begin
FTimer.Enabled := False;
if (not FNoShowClick) and Assigned(FOnClick) then
FOnClick(self);
FNoShowClick := False;
end;procedure TTrayNotifyIcon.SendTrayMessage(Msg : DWORD; Flags : UINT);
begin
with Tnd do
begin
cbSize := Sizeof(Tnd);
StrPLCopy(szTip, PChar(FHINT), SizeOf(szTip));
uFlags := FLags;
uID := UINT(Self);
Wnd := IconMgr.HWindow;
uCallbackMessage := DDGM_TRAYICON;
hIcon := ActiveIconHandle;
end;
Shell_NotifyIcon(Msg, @Tnd);
end;procedure TTrayNotifyIcon.SetHideTask(Value : Boolean);
const
ShowArray : Array[Boolean] of integer = (sw_ShowNormal, sw_hide);
begin
if FHideTask <> Value then
begin
FHideTask := Value;
if not(csDesigning in ComponentState) then
ShowWindow(Application.Handle, ShowArray[FHideTask]);
end;
end;procedure TTrayNotifyIcon.SetHint(Value : String);
begin
if FHint <> Value then
begin
FHint := Value;
if FIconVisible then
SendTrayMessage(NIM_MODIFY, NIF_TIP);
end;
end;procedure TTrayNotifyIcon.SetIcon(Value : TIcon);
begin
FIcon.Assign(Value);
if FIconVisible then SendTraymessage(NIM_MODIFY, NIF_ICON);
end;procedure TTrayNotifyIcon.SetIconVisible(Value : Boolean);
const
MsgArray : array[boolean] of DWORD = (NIM_DELETE, NIM_ADD);
begin
if FIconVisible <> Value then
begin
FIconVisible := Value;
SendTrayMessage(MsgArray[Value], NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;
end;procedure TTrayNotifyIcon.SetPopupMenu(Value : TPopupMenu);
begin
FPopupMenu := Value;
if Value <> nil then Value.FreeNotification(self);
end;const
TraymsgStr = 'Michael.TrayNotifyIconMsg';initialization DDGM_TRAYICON := RegisterWindowMessage(TraymsgStr);
IconMgr := TIconManager.Create;finalization
IconMgr.Free; end.//结束控件在win98下运行都正常,而在win2k或winnt下,如果程序在运行,
“开始”-->“关闭系统”时,无反应,无法关闭操作系统,必须把该
程序关闭后,才能退出操作系统,请高手帮我检查一下
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Menus, ShellAPI;type
ENotifyIconError = class(Exception);
TTrayNotifyIcon = class(TComponent)
private
{ Private declarations }
FDefaultIcon : THandle;
FIcon : TIcon;
FHideTask : Boolean;
FHint : string;
FIconVisible : Boolean;
FPopupMenu : TPopupMenu;
FOnClick : TNotifyEvent;
FOnDblClick : TNotifyEvent;
FNoShowClick : Boolean;
FTimer : TTimer;
Tnd : TNotifyIconData;
procedure SetIcon(Value : TIcon);
procedure SetHideTask(Value : Boolean);
procedure SetHint(Value : string);
procedure SetIconVisible(Value : Boolean);
procedure SetPopupMenu(Value : TPopupMenu);
procedure SendTrayMessage(Msg : DWORD; Flags : UINT);
function ActiveIconHandle : THandle;
procedure OnButtonTimer(Sender : TObject);
protected
{ Protected declarations }
procedure Loaded; override;
procedure LoadDefaultIcon; virtual;
procedure Notification(AComponent : TComponent; Operation : TOperation); override;
public
{ Public declarations }
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property Icon : TIcon read FIcon write SetIcon;
property HideTask : Boolean read FHideTask write SetHideTask default False;
property Hint : string read FHint write SetHint;
property IconVisible : Boolean read FIconVisible write SetIconVisible default False;
property PopupMenu : TPopupMenu read FPopupMenu write SetPopupMenu;
property OnClick : TNotifyEvent read FOnClick write FOnClick;
property OnDblClick : TNotifyEvent read FOnDblClick write FOnDblClick;
end;procedure Register;implementationprocedure Register;
begin
RegisterComponents('MICHAEL', [TTrayNotifyIcon]);
end;{TIconManager}Type
TIconManager = class
private
FHWindow : HWnd;
procedure TrayWndProc(var Message : TMessage);
public
constructor Create;
destructor Destroy; override;
property HWindow : HWnd read FHWindow write FHWindow;
end;var
IconMgr : TIconManager;
DDGM_TRAYICON : Integer;constructor TIconManager.Create;
begin
FHWindow := AllocateHWnd(TrayWndProc);
end;destructor TIconManager.Destroy;
begin
if FHWindow <> 0 then DeallocateHWnd(FHWindow);
inherited Destroy;
end;procedure TIconManager.TrayWndProc(var Message : TMessage);
var
pt : TPoint;
TheIcon : TTrayNotifyIcon;
begin
with Message do
begin
if (Msg = DDGM_TRAYICON) then
begin
TheIcon := TTrayNotifyIcon(WParam);
case lParam of
WM_LBUTTONDOWN : TheIcon.FTimer.Enabled := True;
WM_LBUTTONDBLCLK :
begin
TheIcon.FNoShowClick := True;
if Assigned(TheIcon.FOnDblClick) then TheIcon.FOnDblClick(self);
end;
WM_RBUTTONDOWN :
begin
if Assigned(TheIcon.FPopupMenu) then
begin
SetForegroundWindow(IconMgr.HWindow);
GetCursorPos(Pt);
TheIcon.FPopupMenu.Popup(Pt.X, Pt.Y);
PostMessage(IconMgr.HWindow, WM_USER, 0, 0);
end;
end;
end;
end
else
Result := DefWindowProc(FHWindow, Msg, wParam, lParam);
end;
end;{TTrayNotifyIcon}
constructor TTrayNotifyIcon.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FIcon := TIcon.Create;
FTimer := TTimer.Create(self);
with FTimer do
begin
Enabled := False;
Interval := GetDoubleClickTime;
OnTimer := OnButtonTimer;
end;
LoadDefaultIcon;
end;destructor TTrayNotifyIcon.Destroy;
begin
if FIconVisible then SetIConVisible(False);
FIcon.Free;
FTimer.Free;
inherited Destroy;
end;function TTrayNotifyIcon.ActiveIconHandle : THandle;
begin
if (FIcon.Handle <> 0) then
Result := FIcon.Handle
else
Result := FDefaultIcon;end;procedure TTrayNotifyIcon.LoadDefaultIcon;
begin
FDefaultIcon := LoadIcon(0, IDI_WINLOGO);
end;procedure TTrayNotifyIcon.Loaded;
begin
inherited Loaded;
if FIconVisible then
SendTrayMessage(NIM_ADD, NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;procedure TTrayNotifyIcon.Notification(AComponent : TComponent; Operation : TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = PopupMenu) then
PopupMenu := nil;
end;procedure TTrayNotifyIcon.OnButtonTimer(Sender : TObject);
begin
FTimer.Enabled := False;
if (not FNoShowClick) and Assigned(FOnClick) then
FOnClick(self);
FNoShowClick := False;
end;procedure TTrayNotifyIcon.SendTrayMessage(Msg : DWORD; Flags : UINT);
begin
with Tnd do
begin
cbSize := Sizeof(Tnd);
StrPLCopy(szTip, PChar(FHINT), SizeOf(szTip));
uFlags := FLags;
uID := UINT(Self);
Wnd := IconMgr.HWindow;
uCallbackMessage := DDGM_TRAYICON;
hIcon := ActiveIconHandle;
end;
Shell_NotifyIcon(Msg, @Tnd);
end;procedure TTrayNotifyIcon.SetHideTask(Value : Boolean);
const
ShowArray : Array[Boolean] of integer = (sw_ShowNormal, sw_hide);
begin
if FHideTask <> Value then
begin
FHideTask := Value;
if not(csDesigning in ComponentState) then
ShowWindow(Application.Handle, ShowArray[FHideTask]);
end;
end;procedure TTrayNotifyIcon.SetHint(Value : String);
begin
if FHint <> Value then
begin
FHint := Value;
if FIconVisible then
SendTrayMessage(NIM_MODIFY, NIF_TIP);
end;
end;procedure TTrayNotifyIcon.SetIcon(Value : TIcon);
begin
FIcon.Assign(Value);
if FIconVisible then SendTraymessage(NIM_MODIFY, NIF_ICON);
end;procedure TTrayNotifyIcon.SetIconVisible(Value : Boolean);
const
MsgArray : array[boolean] of DWORD = (NIM_DELETE, NIM_ADD);
begin
if FIconVisible <> Value then
begin
FIconVisible := Value;
SendTrayMessage(MsgArray[Value], NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;
end;procedure TTrayNotifyIcon.SetPopupMenu(Value : TPopupMenu);
begin
FPopupMenu := Value;
if Value <> nil then Value.FreeNotification(self);
end;const
TraymsgStr = 'Michael.TrayNotifyIconMsg';initialization DDGM_TRAYICON := RegisterWindowMessage(TraymsgStr);
IconMgr := TIconManager.Create;finalization
IconMgr.Free; end.//结束控件在win98下运行都正常,而在win2k或winnt下,如果程序在运行,
“开始”-->“关闭系统”时,无反应,无法关闭操作系统,必须把该
程序关闭后,才能退出操作系统,请高手帮我检查一下
解决方案 »
- VC编写的DLL函数接口,Delphi调用出错,请指教
- 请高人指点
- 请问如何在Delphi中调用bcp把SQL Server中数据导入到Excel文件中,我用ADOCommand控件执行SQL语句,没有报错,但也没有导出,但是该SQL语
- 要向一个web服务器上传特定文件和文本信息,该如何做呢?我用的 delphi5.急
- 调用Handle函数系统报错,可已经在USES中加入了Windows
- 怎样删除日期字段中日期为空的记录?
- 请问怎样检测ADOCONNECTION的状态?
- Delphi+BDE+Oracle,关于200分的问题!
- 怎样刷新数据集中的数据
- 关于多线程SERVERSOCKET的重点问题
- 求《Delphi 7项目开发实践》前言的电子版
- [问题]API函数ReadFile相关
nid.cbSize := sizeof(nid); // nid变量的字节数
nid.Wnd := Handle; // 主窗口句柄
nid.uID := 1; // 内部标识,可设为任意数
nid.hIcon := Application.Icon.Handle; // 要加入的图标句柄,可任意指
nid.szTip := '光驱护理'; // 提示字符串
nid.uCallbackMessage := MY_MESSAGE; // 回调函数消息
nid.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE; // 指明哪些字段有
if not Shell_NotifyIcon(NIM_ADD, @nid) then
begin
showwindow(application.Handle,sw_hide);
end;
setwindowlong(application.Handle,Gwl_exstyle,Ws_ex_toolwindow);