DELPHI5怎么做托盘呀！

[clark_x]

请耐心给可操作的方法 或者EMAIL给我 [e-mail] 多谢

[wangchinaking]

推荐下载吧，这样会省很多事。
http://www.csdn.net/cnshare/soft/12/12349.shtm

[票票飞扬]

去找个控件就可以了。
TrayIcon

[clark_x]

你的意思是找到这个控件，还要加入系统控件，然后结合到我的程序中去吗？

[stanely]

unit SysTray_San;

interface
uses
windows,messages,sysutils,classes,graphics,
controls,shellapi,extctrls,menus,forms;
const
NIF_INFO = $10;
NIM_SETVERSION = $00000004;
NOTIFYICON_VERSION = 3;
NIM_SETFOCUS = $00000003;
NIIF_INFO = $00000001;
NIIF_WARNING = $00000002;
NIIF_ERROR = $00000003;

NIN_BALLOONSHOW = WM_USER + 2;
NIN_BALLOONHIDE = WM_USER + 3;
NIN_BALLOONTIMEOUT = WM_USER + 4;
NIN_BALLOONUSERCLICK = WM_USER + 5;
NIN_SELECT = WM_USER + 0;
NINF_KEY = $1;
NIN_KEYSELECT = NIN_SELECT or NINF_KEY;
////////////////////////
TRAY_CALLBACK = WM_USER + 8250;
/////////////////////////
POMM=0;
POLBDOWN=1;
POLBUP=2;
POLBDBC=3;
PORBDOWN=4;
PORBUP=5;
PORBDBC=6;
/////////////////////////
type

TpopupOptionsRange=POMM..PORBDBC;
TPopupOptions=set of TPopupOptionsRange;

PNewNotifyIconData = ^TNewNotifyIconData;

TDUMMYUNIONNAME = Record
case Integer of
0: (uTimeout: UINT);
1: (uVersion: UINT);
end;

TNewNotifyIconData = Record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array [0..127] of Char; //Version 5.0为128个，以前为64个
dwState: DWORD; //Version 5.0
dwStateMask: DWORD; //Version 5.0
szInfo: array [0..255] of Char; //Version 5.0
DUMMYUNIONNAME: TDUMMYUNIONNAME;
szInfoTitle: array [0..63] of Char; //Version 5.0
dwInfoFlags: DWORD; //Version 5.0
end;
////////////////////////////////////////
////////////////////////////////////////
////////////////////////////////////////
TSysTray_San=class(TWinControl)
private
FormHandle:cardinal;
TrayHint:string;
////////////
Timer:TTimer;
CurrentIconIndex:integer;

IconData:TNewNotifyIconData;
PopupMenu:TPopupMenu;
Added:boolean;
IconHandle:HICON;
IconList:TImageList;
/////////////
BalloonTitle:string;
BalloonText:string;
////////////
procedure OnTimer(sender:tobject);
//////////////
procedure SysTrayIconMsgHandler(var Msg: TMessage); message TRAY_CALLBACK;
public
PopUpOptions:TPopupOptions;

OnMouseMove:TNotifyEvent;

OnLeftMouseDown:TNotifyEvent;
OnLeftMouseUp:TNotifyEvent;
OnLeftMouseDbClick:TNotifyEvent;

OnRightMouseDown:TNotifyEvent;
OnRightMouseUp:TNotifyEvent;
OnRightMouseDbClick:TNotifyEvent;

OnBalloonShow:TNotifyEvent;
OnBalloonHide:TNotifyEvent;
OnBalloonTimeOut:TNotifyEvent;
OnBalloonClick:TNotifyEvent;

////////////////////
HideOnMin:boolean;
////////////////////
constructor Create(AForm:TForm);
destructor Destroy;override;
////////////////////
function Showed:boolean;
procedure SetPopupMenu(APopupMenu:TPopUpMenu);
function GetPopupMenu:TPopupMenu;
procedure SetAnimation(Value:boolean);
procedure SetInterval(Value:integer);
function GetInterval:integer;
procedure SetIconList(List:TImageList);

procedure ChangeIconByIndex(Index:integer);
procedure ChangeIconHandle(AIconHandle:HIcon);
function GetIconHandle:HIcon;
procedure SetHint(AStr:string);
function GetHint:string;
/////////////////////
procedure AddSysTrayIcon(AIconHandle:HICON);
procedure DeleteSysTrayIcon;
function ShowBalloonTips(Text,Title:string;Time:cardinal=3000):boolean;
///////////////////
procedure ShowMainForm;
procedure HideMainForm;

end;
///////////////////////////////////
implementation

{ TSysTray_San }

procedure TSysTray_San.AddSysTrayIcon(AIconHandle:HICON);
begin


iconhandle:=aiconhandle;
IconData.hIcon := aiconhandle; //此处为一 Icon 的 Handle


added:=Shell_NotifyIcon(NIM_ADD, @IconData) ;

end;

constructor TSysTray_San.Create(Aform: Tform);
begin
inherited create(aform);
added:=false;
formhandle:=aform.Handle;
popupoptions:=[];
timer:=ttimer.create(self);
timer.OnTimer:=ontimer;
timer.Enabled:=false;
////////////////
icondata.cbSize:=sizeof(icondata);
IconData.Wnd := AllocateHWnd(SysTrayIconMsgHandler);
IconData.uCallbackMessage := TRAY_CALLBACK;
IconData.uID := 0;
IconData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
///////////////
hideonmin:=true;

end;

procedure TSysTray_San.DeleteSysTrayIcon;
begin
DeallocateHWnd(IconData.Wnd);
added:=not Shell_NotifyIcon(NIM_DELETE, @IconData);

end;

destructor TSysTray_San.Destroy;
begin
timer.Free;
if added then
self.DeleteSysTrayIcon;
inherited;
end;



function TSysTray_San.GetIconHandle: HIcon;
begin
result:=iconhandle;
end;

function TSysTray_San.GetInterval: integer;
begin
result:=timer.Interval;
end;

procedure TSysTray_San.SetAnimation(Value: boolean);
begin
timer.Enabled:=value;

end;




procedure TSysTray_San.ChangeIconHandle(AIconHandle: HIcon);
begin
icondata.hIcon:=aiconhandle;

IconData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
Shell_NotifyIcon(NIM_MODIFY, @IconData);
end;

procedure TSysTray_San.SetIconList(List: TImageList);
begin
iconlist:=list;
end;

procedure TSysTray_San.SetInterval(Value: integer);
begin
timer.Interval:=value;
end;

procedure TSysTray_San.SetPopupMenu(APopupMenu: TPopUpMenu);
begin
popupmenu:=apopupmenu;
end;

function TSysTray_San.ShowBalloonTips(Text,Title:string;Time:cardinal=3000):boolean;
begin

IconData.uFlags := NIF_INFO;

strPLCopy(IconData.szInfo, text, sizeof(IconData.szInfo) - 1);

IconData.DUMMYUNIONNAME.uTimeout := time;


strPLCopy(IconData.szInfoTitle, Title, sizeof(IconData.szInfoTitle) - 1);

IconData.dwInfoFlags := NIIF_INFO; //NIIF_ERROR; //NIIF_WARNING;

result:=Shell_NotifyIcon(NIM_MODIFY, @IconData);
//下面的代码实际上没有用，去掉也可以（至少目前这样认为）

//IconData.DUMMYUNIONNAME.uVersion := NOTIFYICON_VERSION;

//result:= Shell_NotifyIcon(NIM_SETVERSION, @IconData);
end;

[stanely]

function TSysTray_San.Showed: boolean;
begin
result:=added;
end;

procedure TSysTray_San.SysTrayIconMsgHandler(var Msg: TMessage);
var
p:tpoint;
begin
getcursorpos(p);
case Msg.LParam of
WM_MOUSEMOVE:
begin
if assigned(popupmenu)and (pomm in popupoptions)then
popupmenu.Popup(p.X,p.Y);
if assigned(onmousemove) then
self.OnMouseMove(self);
end;
WM_LBUTTONDOWN:
begin
if assigned(popupmenu)and (polbdown in popupoptions)then
popupmenu.Popup(p.X,p.Y);
if assigned(onleftmousedown) then
self.OnLeftMouseDown(self);
end;
WM_LBUTTONUP:
begin
if assigned(popupmenu)and (polbup in popupoptions)then
popupmenu.Popup(p.X,p.Y);
if assigned(onleftmouseup) then
self.OnLeftMouseUp(self);
end;
WM_LBUTTONDBLCLK:
begin
if assigned(popupmenu)and (polbdbc in popupoptions)then
popupmenu.Popup(p.X,p.Y);
if assigned(onleftmousedbclick) then
self.OnLeftMouseDbClick(self);
end;
WM_RBUTTONDOWN:
begin
if assigned(popupmenu)and (porbdown in popupoptions)then
popupmenu.Popup(p.X,p.Y);
if assigned(onrightmousedown) then
self.OnRightMouseDown(self);
end;
WM_RBUTTONUP:
begin
if assigned(popupmenu)and (porbup in popupoptions)then
popupmenu.Popup(p.X,p.Y);
if assigned(onrightmouseup) then
self.OnRightMouseUp(self);
end;
WM_RBUTTONDBLCLK:
begin
if assigned(popupmenu)and (porbdbc in popupoptions)then
popupmenu.Popup(p.X,p.Y);
if assigned(onrightmousedbclick) then
self.OnRightMouseDbClick(self);
end;
//以下为新加入的消息
NIN_BALLOONSHOW:
if assigned(onballoonshow) then {当 Balloon Tips 弹出时执行}
self.OnBalloonShow(self);// showmessage('NIN_BALLOONSHOW');
NIN_BALLOONHIDE:
if assigned(onballoonhide) then {当 Balloon Tips 消失时执行（例如 SysTrayIcon 被删除），但指定的 TimeOut 时间到或鼠标点击 Balloon Tips 后的消失不发送此消息}
self.OnBalloonHide(self);// showmessage('NIN_BALLOONHIDE');
NIN_BALLOONTIMEOUT:
if assigned(onballoontimeout) then {当 Balloon Tips 的 TimeOut 时间到时执行}
self.OnBalloonTimeOut(self);// showmessage('NIN_BALLOONTIMEOUT');
NIN_BALLOONUSERCLICK:
if assigned(onballoonclick) then
self.onballoonclick(self); {当鼠标点击 Balloon Tips 时执行。
注意：在XP下执行时 Balloon Tips 上有个关闭按钮，而且 Balloon Tips
一直显示（IconData.DUMMYUNIONNAME.uTimeout := 3000;
这句话设定的时间没有用，我的测试是这样的），
如果鼠标点在按钮上将接收到 NIN_BALLOONTIMEOUT 消息。}
//showmessage('NIN_BALLOONUSERCLICK');
else
//beep;
end;
end;

procedure TSysTray_San.OnTimer(sender: tobject);
begin
if iconlist<>nil then
begin
if currenticonindex>iconlist.Count-1 then
currenticonindex:=0;
changeiconbyindex(currenticonindex);
inc(currenticonindex);
end;
end;

function TSysTray_San.GetPopupMenu: TPopupMenu;
begin
result:=popupmenu;
end;



function TSysTray_San.GetHint: string;
begin
result:=trayhint;
end;

procedure TSysTray_San.SetHint(AStr: string);
begin
trayhint:=astr;
strPLCopy(IconData.sztip, astr, sizeof(IconData.szInfo) - 1);
IconData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
Shell_NotifyIcon(NIM_MODIFY, @IconData);
end;

procedure TSysTray_San.changeIconbyindex(Index: integer);
var
icn:ticon;
begin
if iconlist=nil then exit;
icn:=ticon.Create;
iconlist.GetIcon(index,icn);
changeiconhandle(icn.Handle);
icn.Free;

end;

procedure TSysTray_San.HideMainForm;
begin
showwindow(formhandle,sw_hide);
if hideonmin then
ShowWindow(Application.Handle, SW_HIDE);
end;

procedure TSysTray_San.ShowMainForm;
begin
showwindow(formhandle,sw_show);
end;

end.

[stanely]

unit Unit1;

interface

uses
Windows,systray_san, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
sys:tsystray_san;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
sys:=tsystray_san.Create(self);
sys.AddSysTrayIcon(application.Icon.Handle);

end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
sys.Free;
end;

end.

[DelUser]

写的不错！

[wanderung]

有上面的那么多吗？那里用的着这么麻烦~！

了解notifyicondata数据结构，然后对该数据结构改变即可~！
记得要引用shellapi哟~！

通过shell_notifyicon来对托盘管理

[wxjh]

shell_notifyicon

[广州接入]

不会这么长代码吧？

procedure TEShellShellIcon.AddIconToShell(AForm:TForm;Msg:TMessage;strTip:string);
var
lpData:PNotifyIconData;
begin
if Msg.WParam = SC_ICON then
begin
//如果用户最小化窗口则将窗口隐藏并在任务栏上添加图标
lpData := new(PNotifyIconDataA);
lpData.cbSize := SizeOf(NotifyIconDataA);
lpData.Wnd := AForm.Handle;
lpData.hIcon := AForm.Icon.Handle;
lpData.uCallbackMessage := WM_BARICON;
lpData.uID :=0;
strpcopy(lpData.szTip,strtip);
lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
Shell_NotifyIcon(NIM_ADD,lpData);
dispose(lpData);
AForm.Visible := False;
end
else
begin
//如果是其它的SystemCommand消息则调用系统缺省处理函数处理之。
DefWindowProc(AForm.Handle,Msg.Msg,Msg.WParam,Msg.LParam);
end;
end;

procedure TEShellShellIcon.DelIConFromShell(AForm: TForm; Msg: TMessage;strTip:string);
var
lpData:PNotifyIconData;
begin
if (Msg.LParam = WM_LBUTTONDOWN) then
begin
//如果用户点击任务栏图标则将图标删除并回复窗口。
lpData := new(PNotifyIconDataA);
lpData.cbSize := SizeOf(NotifyIconDataA);
lpData.Wnd := AForm.Handle;
lpData.hIcon := AForm.Icon.Handle;
lpData.uCallbackMessage := WM_BARICON;
lpData.uID :=0;
strpcopy(lpData.szTip,strtip);
lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
Shell_NotifyIcon(NIM_DELETE,lpData);
dispose(lpData);
AForm.Visible := True;
end;
end;

这是加删托盘的代码。好好研究一下Shell_NotifyIcon就可以了.

[stanely]

//算啦，各位啥也别说了，来点实在的----给你贴cooltrayicon代码，目前最cool的delphi系统托盘控件,比我写的那个可“冗长”多了！（别忘了赶紧结账阿:P）：
/////////////////////////////////////////////////
{*****************************************************************}
{ This is a component for placing icons in the notification area }
{ of the Windows taskbar (aka. the traybar). }
{ }
{ The component is freeware. Feel free to use and improve it. }
{ I would be pleased to hear what you think. }
{ }
{ Troels Jakobsen - [e-mail] }
{ Copyright (c) 2001 }
{*****************************************************************}

unit CoolTrayIcon;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Menus, ShellApi, ExtCtrls;

const
{ Define user-defined message sent by the trayicon. We avoid low user-defined
messages that are used by Windows itself (eg. WM_USER+1 = DM_SETDEFID). }
WM_TRAYNOTIFY = WM_USER + 1024;
// Constant used for recreating trayicon on system traybar recover
IconID = 1;
// Constants used for balloon hint feature
WM_RESETTOOLTIP = WM_USER + 1025;
NIIF_NONE = $00000000;
NIIF_INFO = $00000001;
NIIF_WARNING = $00000002;
NIIF_ERROR = $00000003;
NIF_INFO = $00000010;

var
WM_TASKBARCREATED: Cardinal;

type
{ You can use the TNotifyIconData record structure defined in shellapi.pas.
However, WinME, Win2000, and WinXP have expanded this structure. We define
a similar structure, TNotifyIconDataEx. }
TNotifyIconDataEx = record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
// szTip: array[0..63] of AnsiChar;
szTip: array[0..127] of AnsiChar; // 0..63 of WideChar in stead?
dwState: DWORD;
dwStateMask: DWORD;
szInfo: array[0..255] of AnsiChar;
uTimeout: UINT; // union with uVersion: UINT;
szInfoTitle: array[0..63] of AnsiChar;
dwInfoFlags: DWORD;
end;

TBalloonHintIcon = (bitNone, bitInfo, bitWarning, bitError);
TBalloonHintTimeOut = 10..60; // Windows defines 10-60 secs. as min-max

TCycleEvent = procedure(Sender: TObject; NextIndex: Integer) of object;

TCoolTrayIcon = class(TComponent)
private
FEnabled: Boolean;
FIcon: TIcon;
FIconVisible: Boolean;
FHint: String;
FShowHint: Boolean;
FPopupMenu: TPopupMenu;
FLeftPopup: Boolean;
FOnClick,
FOnDblClick: TNotifyEvent;
FOnCycle: TCycleEvent;
FOnMouseDown,
FOnMouseUp: TMouseEvent;
FOnMouseMove: TMouseMoveEvent;
FStartMinimized: Boolean;
FMinimizeToTray: Boolean;
FClickStart: Boolean;
CycleTimer: TTimer; // For icon cycling
FIconIndex: Integer; // Current index in imagelist
FDesignPreview: Boolean;
SettingPreview: Boolean; // Internal status flag
SettingMDIForm: Boolean; // Internal status flag
FIconList: TImageList;
FCycleIcons: Boolean;
FCycleInterval: Cardinal;
OldAppProc, NewAppProc: Pointer; // Procedure variables
OldWndProc, NewWndProc: Pointer; // Procedure variables
FWindowHandle: HWND; // Window handle (not general handle)
procedure SetCycleIcons(Value: Boolean);
procedure SetDesignPreview(Value: Boolean);
procedure SetCycleInterval(Value: Cardinal);
procedure TimerCycle(Sender: TObject);
procedure HandleIconMessage(var Msg: TMessage);
function InitIcon: Boolean;
procedure SetIcon(Value: TIcon);
procedure SetIconVisible(Value: Boolean);
procedure SetIconList(Value: TImageList);
procedure SetIconIndex(Value: Integer);
procedure SetHint(Value: String);
procedure SetShowHint(Value: Boolean);
procedure PopupAtCursor;
procedure HookApp;
procedure UnhookApp;
procedure HookAppProc(var Msg: TMessage);
procedure HookParent;
procedure UnhookParent;
procedure HookWndProc(var Msg: TMessage);
protected
IconData: TNotifyIconDataEx; // Data of the tray icon wnd.
procedure Loaded; override;
function ShowIcon: Boolean; virtual;
function HideIcon: Boolean; virtual;
function ModifyIcon: Boolean; virtual;
procedure Click; dynamic;
procedure DblClick; dynamic;
procedure CycleIcon; dynamic;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); dynamic;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); dynamic;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); dynamic;
procedure DoMinimizeToTray; dynamic;
procedure Notification(AComponent: TComponent; Operation: TOperation);
override;
public
{$IFDEF DFS_CPPB_3_UP}
property Handle: HWND read IconData.hWnd;
{$ELSE}
property Handle: HWND read IconData.Wnd;
{$ENDIF}
property WindowHandle: HWND read FWindowHandle;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ShowMainForm;
procedure HideMainForm;
function Refresh: Boolean;
function ShowBalloonHint(Title: String; Text: String; IconType: TBalloonHintIcon;
TimeoutSecs: TBalloonHintTimeOut): Boolean;
function BitmapToIcon(const Bitmap: TBitmap; const Icon: TIcon;
MaskColor: TColor): Boolean;
published
// Properties:
property DesignPreview: Boolean read FDesignPreview
write SetDesignPreview default False;
property IconList: TImageList read FIconList write SetIconList;
property CycleIcons: Boolean read FCycleIcons write SetCycleIcons
default False;
property CycleInterval: Cardinal read FCycleInterval
write SetCycleInterval;
property Enabled: Boolean read FEnabled write FEnabled default True;
property Hint: String read FHint write SetHint;
property ShowHint: Boolean read FShowHint write SetShowHint
default True;
property Icon: TIcon read FIcon write SetIcon stored True;
property IconVisible: Boolean read FIconVisible write SetIconVisible
default True;
property IconIndex: Integer read FIconIndex write SetIconIndex;
property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
property LeftPopup: Boolean read FLeftPopup write FLeftPopup
default False;
property StartMinimized: Boolean read FStartMinimized write FStartMinimized
default False; // Main form minimized on app. start-up?
property MinimizeToTray: Boolean read FMinimizeToTray write FMinimizeToTray
default False; // Minimize main form to tray when minimizing?
// Events:
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnCycle: TCycleEvent read FOnCycle write FOnCycle;
end;

procedure Register;

[stanely]

implamentation太长了，告诉我你email
发给你！

[stanely]

实现基本的功能根本连class都不用写！
长短是按功能定的！

大家看看cooltrayicon的代码吧！

几个systray的能实现balloon提示？？

[huyalin]

少点事吧
装个RX控件不就行了

[zhptj]

还是使用cooltrayicon这个控件吧
其实delphi5程序员指南里有

[火鸟李国平]

Var IconData : TNotifyIconData;
Const
wm_MyCallback = wm_User+1000;
cm_Exit = 100;
cm_About = 101;
begin
With IconData do Begin
cbSize := SizeOf(IconData);
Wnd := handle;
uID := 1;
uFlags := nif_Icon Or nif_Message Or nif_Tip;
hicon:=extracticon(hInstance,'d:\ico\001.ico',0);
lstrcpy (szTip,'视窗超人');
uCallBackMessage := wm_MyCallBack;
Shell_NotifyIcon(nim_Add,@IconData); //加入

Shell_NotifyIcon (nim_Delete, @IconData);//删除
End;

end;