收集的两个托盘程序：
1、
托盘区就是在windows的状态栏下方显示时钟、输入法状态的地方，
要把你的程序显示在托盘区：
下面是一个托盘类，只要把下面粘贴到文本文件中，改成TrayIcon.pas，使用时uses TrayIcon就可以了。
先声明一个全局变量：
var tray:TTrayNotifyIcon;
然后在窗体的OnCreate事件中：
tray:=TTrayNotifyIcon.Create(self);//将窗体创建为托盘
tray.Icon:=application.Icon;//定义托盘的显示图标
tray.IconVisible:=true;//托盘可见
tray.PopupMenu:=popmenu;//给托盘定义一个右击时的弹出菜单
tray.OnDblClick:=trayDblClick;//给托盘定义一个双击事件(当然要自己写了，不过多数情况只有一行，就是Form1.show);
unit TrayIcon;
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;
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
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;
implementation
{ TIconManager }
{ This class creates a hidden window which handles and routes }
{ tray icon messages }
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: Cardinal;
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 messages }
{ 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 not occurred. }
WM_LBUTTONDOWN: TheIcon.FTimer.Enabled := True;
{ Set no click flag on double click. This will supress }
{ 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 cursor 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
FTimer.Free;
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 default when 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 click. This delays the first click long enough to }
{ ensure that a double click hasn’t occurred. The whole }
{ point of these gymnastics is to allow the component to }
{ receive OnClicks and OnDblClicks independently. }
begin
{ Disable timer because we only want it 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 := UINT(Self);
Wnd := IconMgr.HWindow;
uCallbackMessage := DDGM_TRAYICON;
hIcon := ActiveIconHandle;
end;
Shell_NotifyIcon(Msg, @Tnd);
end;
procedure TTrayNotifyIcon.SetHideTask(Value: Boolean);
{ Write method for HideTask property }
const
{ Flags to show application normally or 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 tray notification area }
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 notification 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.
2、
{ SysTray on taskbar component }
{ Copyright (c) 2001 by Mandys Tomas -
MandySoft }
{ email: tomas.mandys@2p.cz }
{ URL: http://www.2p.cz }
unit SysTray;
interface
uses
SysUtils, Classes, Windows, Messages, Forms,
Controls, ShellApi, Menus, Graphics;
const
WM_SYSTRAY = WM_USER + 299;
type
TSysTrayHint = string[63];
TSysTray = class(TComponent)
private
FWindowHandle: HWND;
FIconData:
TNotifyIconData;
FOnMouseDown:
TMouseEvent;
FOnMouseMove:
TMouseMoveEvent;
FOnMouseUp:
TMouseEvent;
FOnClick: TNotifyEvent;
FOnDblClick: TNotifyEvent;
FPopupMenu:
TPopupMenu;
NT351: Boolean;
FVisible: Boolean;
FIcon: TIcon;
function GetHint: TSysTrayHint;
procedure SetHint(const
Value: TSysTrayHint);
procedure WndProc(var Msg:
TMessage);
function GetIconHandle:
hIcon;
procedure SetPopupMenu(Value:
TPopupMenu);
procedure SetVisible(const Value:
Boolean);
function IsIconStored:
Boolean;
procedure SetIcon(const Value:
TIcon);
procedure IconChanged(Sender: TObject);
protected
procedure MouseDown(Button: TMouseButton; Shift:
TShiftState;
X, Y: Integer);
dynamic;
procedure MouseMove(Shift: TShiftState; X, Y:
Integer); dynamic;
procedure MouseUp(Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
dynamic;
procedure Click; dynamic;
procedure DblClick; dynamic;
procedure
Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(aOwner: TComponent);
override;
destructor Destroy; override;
published
property Visible: Boolean read FVisible write
SetVisible;
property PopupMenu: TPopupMenu read FPopupMenu
write SetPopupMenu;
property Icon: TIcon read FIcon write
SetIcon stored IsIconStored;
property Hint: TSysTrayHint
read GetHint write SetHint;
property OnClick: TNotifyEvent
read FOnClick write FOnClick;
property OnDblClick:
TNotifyEvent read FOnDblClick write FOnDblClick;
property
OnMouseDown: TMouseEvent read FOnMouseDown write
FOnMouseDown;
property OnMouseMove: TMouseMoveEvent read
FOnMouseMove write FOnMouseMove;
property OnMouseUp:
TMouseEvent read FOnMouseUp write FOnMouseUp;
end;
procedure Register;
implementation
{ TSysTray }
constructor TSysTray.Create(aOwner: TComponent);
begin
inherited;
FIcon := TIcon.Create;
FIcon.Width :=
GetSystemMetrics(SM_CXSMICON);
FIcon.Height :=
GetSystemMetrics(SM_CYSMICON);
FIcon.OnChange :=
IconChanged;
NT351 := (Win32MajorVersion <= 3) and (Win32Platform =
VER_PLATFORM_WIN32_NT);
FWindowHandle :=
AllocateHWnd(WndProc);
end;
destructor TSysTray.Destroy;
begin
Visible:= False;
DeallocateHWnd(FWindowHandle);
FIcon.Free;
inherited;
end;
procedure TSysTray.WndProc(var Msg: TMessage);
var
pt:
TPoint;
begin
if (Msg.Msg = WM_SYSTRAY) and (Msg.wParam =
fIconData.uID) then
try
case Msg.LParam of
WM_LBUTTONUP:
with
TWMMouse(Msg) do
begin
// if
PtInRect(ClientRect, SmallPointToPoint(Pos))
then
Click;
MouseUp(mbLeft, KeysToShiftState(Keys), XPos,
YPos);
end;
WM_MBUTTONUP:
with
TWMMouse(Msg) do
MouseUp(mbMiddle, KeysToShiftState(Keys), XPos,
YPos);
WM_RBUTTONUP:
with
TWMMouse(Msg)
do
MouseUp(mbRight, KeysToShiftState(Keys), XPos,
YPos);
WM_MOUSEMOVE:
with TWMMouseMove(Msg)
do
MouseMove(KeysToShiftState(Keys), XPos,
YPos);
WM_LBUTTONDOWN:
with
TWMMouse(Msg)
do
MouseDown(mbLeft, KeysToShiftState(Keys), XPos,
YPos);
WM_MBUTTONDOWN:
with
TWMMouse(Msg)
do
MouseDown(mbMiddle, KeysToShiftState(Keys), XPos,
YPos);
WM_RBUTTONDOWN:
with
TWMMouse(Msg) do
begin
MouseDown(mbRight, KeysToShiftState(Keys), XPos,
YPos);
Pt
:=
SmallPointToPoint(Pos);
if (fPopupMenu <> nil) and fPopupMenu.AutoPopup
then
begin
GetCursorPos(pt);
fPopupMenu.PopupComponent :=
Self;
fPopupMenu.Popup(Pt.X,
Pt.Y);
end;
end;
WM_LBUTTONDBLCLK:
with
TWMMouse(Msg) do
begin
DblClick;
MouseDown(mbLeft, KeysToShiftState(Keys)+[ssDouble], XPos,
YPos);
end;
WM_MBUTTONDBLCLK:
with
TWMMouse(Msg)
do
MouseDown(mbMiddle, KeysToShiftState(Keys)+[ssDouble], XPos,
YPos);
WM_RBUTTONDBLCLK:
with
TWMMouse(Msg)
do
MouseDown(mbRight, KeysToShiftState(Keys)+[ssDouble], XPos,
YPos);
end;
except
Application.HandleException(Self);
end
else
Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg,
Msg.wParam, Msg.lParam);
end;
function TSysTray.GetHint: TSysTrayHint;
begin
Result:=
StrPas(FIconData.szTip);
end;
procedure TSysTray.SetHint(const Value: TSysTrayHint);
begin
if
Value <> GetHint then
begin
StrPLCopy(FIconData.szTip, Value,
SizeOf(FIconData.szTip)-1);
if not NT351
then
Shell_NotifyIcon(NIM_Modify,
@FIconData);
end;
end;
procedure TSysTray.MouseDown(Button: TMouseButton; Shift: TShiftState;
X,
Y: Integer);
begin
if Assigned(FOnMouseDown)
then
FOnMouseDown(Self, Button, Shift, X, Y);
end;
procedure TSysTray.MouseMove(Shift: TShiftState; X, Y:
Integer);
begin
if Assigned(FOnMouseMove)
then
FOnMouseMove(Self, Shift, X, Y);
end;
procedure TSysTray.MouseUp(Button: TMouseButton; Shift: TShiftState;
X,
Y: Integer);
begin
if Assigned(FOnMouseUp)
then
FOnMouseUp(Self, Button, Shift, X, Y);
end;
procedure TSysTray.Click;
begin
if Assigned(FOnClick)
then
FOnClick(Self);
end;
procedure TSysTray.DblClick;
begin
if Assigned(FOnDblClick)
then
FOnDblClick(Self);
end;
procedure TSysTray.SetPopupMenu(Value: TPopupMenu);
begin
FPopupMenu := Value;
if Value <> nil then
begin
Value.FreeNotification(Self);
end;
end;
procedure TSysTray.Notification(AComponent: TComponent; Operation:
TOperation);
begin
inherited Notification(AComponent,
Operation);
if Operation = opRemove then
if
AComponent = PopupMenu then
PopupMenu :=
nil;
end;
procedure TSysTray.SetVisible(const Value: Boolean);
begin
if
not NT351 and not (csDesigning in ComponentState) then
begin
if Value then
begin
with FIconData
do
begin
cbSize :=
SizeOf(FIconData);
Wnd
:= fWindowHandle;
uID
:= Integer(Self);
uFlags := NIF_MESSAGE or NIF_ICON or
NIF_TIP;
uCallbackMessage :=
WM_SYSTRAY;
hIcon:=
GetIconHandle;
end;
Shell_NotifyIcon(NIM_Add,
@FIconData);
end
else
begin
Shell_NotifyIcon(NIM_DELETE,
@FIconData);
end;
end;
FVisible := Value;
end;
function TSysTray.IsIconStored: Boolean;
begin
Result :=
fIcon.Handle <> 0;
end;
procedure TSysTray.SetIcon(const Value: TIcon);
begin
FIcon.Assign(Value);
end;
function TSysTray.GetIconHandle: HICON;
begin
Result :=
FIcon.Handle;
if Result = 0 then
Result :=
Application.Icon.Handle;
end;
procedure TSysTray.IconChanged(Sender: TObject);
begin
fIconData.hIcon:= GetIconHandle;
Shell_NotifyIcon(NIM_Modify,
@FIconData);
end;
procedure Register;
begin
RegisterComponents(‘Win32‘,
[TSysTray]);
end;
end.
原文：http://www.cnblogs.com/FuYan/p/3589693.html