给你一个托盘控件的源代码,使用它published里的属性和方法就可以了
unit TrayNotifyIcon;
interface
uses Windows, SysUtils, Messages, ShellAPI, Classes, Graphics, Forms, Menus, StdCtrls, ExtCtrls;
type
EnotifyIconError = class(Exception);
TTrayNotifyIcon = class(TComponent)
private
FDefaultIcon: THandle;
FIcon: TIcon;
FHideTask: Boolean;
FHint: string;
FIconVisible: Boolean;
FPopupMenu: TPopupMenu;
FOnClick: TNotifyEvent;
FOnDblClick: TNotifyEvent;
FOnShowClick: 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
WORD; Flags: UINT);
function ActiveIconHandle: THandle;
procedure OnButtonTimer(Sender: TObject);
protected
procedure Loaded; override;
procedure LoadDefaultIcon; virtual;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
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('Cooton', [TTrayNotifyIcon]);
end;
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.FOnShowClick := 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;
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
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 FOnShowClick) and (Assigned(FOnClick)) then
FOnClick(self);
FOnShowClick := 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
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 = 'DDG.TrayNotifyIconMsg';
initialization
DDGM_TRAYICON := RegisterWindowMessage(TrayMsgStr);
IconMgr := TIconManager.Create;
finalization
IconMgr.Free;
end.