C
coolingxyz
Unregistered / Unconfirmed
GUEST, unregistred user!
这个是《dellphi5开发人员指南》上的例子。当我把鼠标移到托盘图表上时,图表就没有了。 我不知道什么原因。
主程序中是这么用的:
var //定义
TrayNotifyIcon1 : TTrayNotifyIcon;
//formcreate中
TrayNotifyIcon1 := TTrayNotifyIcon.Create(Self);
TrayNotifyIcon1.Icon.LoadFromFile(MyPath + 'pic/sFh.ICO');
TrayNotifyIcon1.IconVisible := True;
unit TrayIcon;
interface
uses
Windows, Messages, SysUtils, Classes, ShellApi, Graphics, Forms, Menus,
StdCtrls, ExtCtrls;
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;
implementation
//procedure Register;
//begin
// RegisterComponents('Samples', [TrayIcon]);
//end;
{TIconManager
This class creates a hidden window which handles and routes tray icon message}
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);
{this allows us to handle all tray callback message
from within the context of the component.}
var
Pt : TPoint;
TheIcon : TTrayNotifyIcon;
begin
With Message do
begin
{if it's the tray callback message}
if (Msg = DDGM_TRAYICON) then
begin
TheIcon := TTrayNotifyIcon(WParam);
case lParam of
{enable timer on first mouse down
onClick will be fired by OnTimer Method, Provided
double click has occurred.}
WM_LBUTTONDOWN : TheIcon.FTimer.Enabled := True;
{Set no click flag on double click. this will suppress
the single click.}
WM_LBUTTONDBLCLK :
begin
TheIcon.FNoShowClick := True;
if Assigned(TheIcon.FOnDblClick) then TheIcon.FOnDblClick(Self);
end;
WM_RBUTTONDOWN :
begin
if Assigned(TheIcon.FPopupMenu) then
begin
{Call to setForegroundWindow is required by API}
SetForegroundWindow(IConMgr.HWindow);
{PoPup local menu at the coursor position.}
GetCursorPos(Pt);
TheIcon.FPopupMenu.Popup(Pt.x,Pt.Y);
{Message Post required by API to force task switch}
PostMessage(IconMgr.HWindow, WM_USER, 0, 0);
end;
end;
end;
end
else
{if it isn't a tray callback message, then call defwindowproc}
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;
{keep default windows icon handy...}
LoadDefaultIcon;
end;
Destructor TTrayNotifyIcon.Destroy;
begin
if FIconVisible then SetIconVisible(False); //destroy icon
FIcon.Free; //free stuff
Inherited Destroy;
end;
Function TTrayNotifyIcon.ActiveIconHandle : THandle;
{Returns handle of active icon}
begin
{if no icon is loaded, then return default icon}
if (FIcon.Handle <> 0) then
Result := FIcon.Handle
else
Result := FDefaultIcon;
end;
Procedure TTrayNotifyIcon.LoadDefaultIcon;
{loads default window icon to keep it handy.
this will allow the component to use the windows logo
icon as the defaut no icon is selected in the icon property.}
begin
FDefaultIcon := LoadIcon(0, IDI_WINLOGO);
end;
Procedure TTrayNotifyIcon.Loaded;
{called after component is loaded from stream}
begin
inherited Loaded;
{if icon is supposed to be visible, create it.}
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);
{Timer used to keep track of time between two clicks of a double.This delays the
first click long enough to ensure that a double click hasn't occured. The whole
point of these grmnastics is to allow the component to receive OnClicks and
OnDblClicks independently.}
begin
{disable timer because we only want to fire once.}
FTimer.Enabled := False;
{If double click has not occurred, then fire single click.}
if (not FNoShowClick) and Assigned(FOnClick) then
FOnClick(Self);
FNoShowClick := False; //reset flag
end;
Procedure TTrayNotifyIcon.SendTrayMessage(Msg : DWORD; Flags : Uint);
{this method wraps up the call to the API's shell_NotifyIcon}
begin
{Fill up record with appropriate values}
with Tnd do
begin
cbSize := SizeOf(Tnd);
StrPLCopy(SzTip, Pchar(Fhint), SizeOf(SzTip));
uFlags := Flags;
uID := IconMgr.HWindow;
uCallbackMessage := DDGM_TRAYICON;
hIcon := ActiveIconHandle;
end;
Shell_NotifyIcon(Msg, @Tnd);
end;
Procedure TTrayNotifyIcon.SetHideTask(Value : Boolean);
{Write method for HideTask Propery}
const
{Flags to show application normally of hide it}
ShowArray : array[Boolean] of integer = (sw_ShowNormal,sw_Hide);
begin
if FHideTask <> Value then
begin
FHideTask := Value;
{DOn't do anything in design mode}
if not (csDesigning in componentState) then
ShowWindow(Application.Handle, ShowArray[FHideTask]);
end;
end;
Procedure TTrayNotifyIcon.SetHint(Value : String);
{Set method for Hint Property}
begin
if FHint <> Value then
begin
FHint := Value;
if FIconVisible then
{Change hint on icon on notification tray}
SendTrayMessage(NIM_MODIFY, NIF_TIP);
end;
end;
Procedure TTrayNotifyIcon.SetIcon(Value : TIcon);
{Write method for icon property}
begin
FIcon.Assign(Value); //Set new Icon
{Change icon on notification tray}
if FIconVisible then SendTrayMessage(NIM_MODIFY, NIF_ICON);
end;
Procedure TTrayNotifyIcon.SetIconVisible(Value : Boolean);
{write method for iconvisible property}
const
{Flags to add or delete a tray-notfication icon}
MsgArray : array[Boolean] of DWORD = (NIM_DELETE, NIM_ADD);
begin
if FIconVisible <> Value then
begin
FIconVisible := Value;
{Set icon as appropriate}
SendTrayMessage(MsgArray[Value],NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;
end;
Procedure TTrayNotifyIcon.SetPopupMenu(Value : TPopupMenu);
{Write method for Popupmenu property}
begin
FPopupMenu := Value;
if Value <> nil then Value.FreeNotification(Self);
end;
const
{String to identify registered window message}
TrayMsgStr = 'DDG.TrayNotifyIconMsg';
initialization
{Get a unique windows message ID for tray callback}
DDGM_TRAYICON := RegisterWindowMessage(TrayMsgStr);
IconMgr := TIconManager.Create;
finalization
IconMgr.Free;
end.
主程序中是这么用的:
var //定义
TrayNotifyIcon1 : TTrayNotifyIcon;
//formcreate中
TrayNotifyIcon1 := TTrayNotifyIcon.Create(Self);
TrayNotifyIcon1.Icon.LoadFromFile(MyPath + 'pic/sFh.ICO');
TrayNotifyIcon1.IconVisible := True;
unit TrayIcon;
interface
uses
Windows, Messages, SysUtils, Classes, ShellApi, Graphics, Forms, Menus,
StdCtrls, ExtCtrls;
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;
implementation
//procedure Register;
//begin
// RegisterComponents('Samples', [TrayIcon]);
//end;
{TIconManager
This class creates a hidden window which handles and routes tray icon message}
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);
{this allows us to handle all tray callback message
from within the context of the component.}
var
Pt : TPoint;
TheIcon : TTrayNotifyIcon;
begin
With Message do
begin
{if it's the tray callback message}
if (Msg = DDGM_TRAYICON) then
begin
TheIcon := TTrayNotifyIcon(WParam);
case lParam of
{enable timer on first mouse down
onClick will be fired by OnTimer Method, Provided
double click has occurred.}
WM_LBUTTONDOWN : TheIcon.FTimer.Enabled := True;
{Set no click flag on double click. this will suppress
the single click.}
WM_LBUTTONDBLCLK :
begin
TheIcon.FNoShowClick := True;
if Assigned(TheIcon.FOnDblClick) then TheIcon.FOnDblClick(Self);
end;
WM_RBUTTONDOWN :
begin
if Assigned(TheIcon.FPopupMenu) then
begin
{Call to setForegroundWindow is required by API}
SetForegroundWindow(IConMgr.HWindow);
{PoPup local menu at the coursor position.}
GetCursorPos(Pt);
TheIcon.FPopupMenu.Popup(Pt.x,Pt.Y);
{Message Post required by API to force task switch}
PostMessage(IconMgr.HWindow, WM_USER, 0, 0);
end;
end;
end;
end
else
{if it isn't a tray callback message, then call defwindowproc}
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;
{keep default windows icon handy...}
LoadDefaultIcon;
end;
Destructor TTrayNotifyIcon.Destroy;
begin
if FIconVisible then SetIconVisible(False); //destroy icon
FIcon.Free; //free stuff
Inherited Destroy;
end;
Function TTrayNotifyIcon.ActiveIconHandle : THandle;
{Returns handle of active icon}
begin
{if no icon is loaded, then return default icon}
if (FIcon.Handle <> 0) then
Result := FIcon.Handle
else
Result := FDefaultIcon;
end;
Procedure TTrayNotifyIcon.LoadDefaultIcon;
{loads default window icon to keep it handy.
this will allow the component to use the windows logo
icon as the defaut no icon is selected in the icon property.}
begin
FDefaultIcon := LoadIcon(0, IDI_WINLOGO);
end;
Procedure TTrayNotifyIcon.Loaded;
{called after component is loaded from stream}
begin
inherited Loaded;
{if icon is supposed to be visible, create it.}
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);
{Timer used to keep track of time between two clicks of a double.This delays the
first click long enough to ensure that a double click hasn't occured. The whole
point of these grmnastics is to allow the component to receive OnClicks and
OnDblClicks independently.}
begin
{disable timer because we only want to fire once.}
FTimer.Enabled := False;
{If double click has not occurred, then fire single click.}
if (not FNoShowClick) and Assigned(FOnClick) then
FOnClick(Self);
FNoShowClick := False; //reset flag
end;
Procedure TTrayNotifyIcon.SendTrayMessage(Msg : DWORD; Flags : Uint);
{this method wraps up the call to the API's shell_NotifyIcon}
begin
{Fill up record with appropriate values}
with Tnd do
begin
cbSize := SizeOf(Tnd);
StrPLCopy(SzTip, Pchar(Fhint), SizeOf(SzTip));
uFlags := Flags;
uID := IconMgr.HWindow;
uCallbackMessage := DDGM_TRAYICON;
hIcon := ActiveIconHandle;
end;
Shell_NotifyIcon(Msg, @Tnd);
end;
Procedure TTrayNotifyIcon.SetHideTask(Value : Boolean);
{Write method for HideTask Propery}
const
{Flags to show application normally of hide it}
ShowArray : array[Boolean] of integer = (sw_ShowNormal,sw_Hide);
begin
if FHideTask <> Value then
begin
FHideTask := Value;
{DOn't do anything in design mode}
if not (csDesigning in componentState) then
ShowWindow(Application.Handle, ShowArray[FHideTask]);
end;
end;
Procedure TTrayNotifyIcon.SetHint(Value : String);
{Set method for Hint Property}
begin
if FHint <> Value then
begin
FHint := Value;
if FIconVisible then
{Change hint on icon on notification tray}
SendTrayMessage(NIM_MODIFY, NIF_TIP);
end;
end;
Procedure TTrayNotifyIcon.SetIcon(Value : TIcon);
{Write method for icon property}
begin
FIcon.Assign(Value); //Set new Icon
{Change icon on notification tray}
if FIconVisible then SendTrayMessage(NIM_MODIFY, NIF_ICON);
end;
Procedure TTrayNotifyIcon.SetIconVisible(Value : Boolean);
{write method for iconvisible property}
const
{Flags to add or delete a tray-notfication icon}
MsgArray : array[Boolean] of DWORD = (NIM_DELETE, NIM_ADD);
begin
if FIconVisible <> Value then
begin
FIconVisible := Value;
{Set icon as appropriate}
SendTrayMessage(MsgArray[Value],NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;
end;
Procedure TTrayNotifyIcon.SetPopupMenu(Value : TPopupMenu);
{Write method for Popupmenu property}
begin
FPopupMenu := Value;
if Value <> nil then Value.FreeNotification(Self);
end;
const
{String to identify registered window message}
TrayMsgStr = 'DDG.TrayNotifyIconMsg';
initialization
{Get a unique windows message ID for tray callback}
DDGM_TRAYICON := RegisterWindowMessage(TrayMsgStr);
IconMgr := TIconManager.Create;
finalization
IconMgr.Free;
end.