DELPHI对Windows系统状态栏编程
河南济源 董占山
最近在网上各编程社区漫游时，发现时常有朋友提出用Delphi对Windows系统状态栏（也称为托盘区，指任务
栏右边显示时间和输入法图标的区域）进行编程的问题，在实际工作中，这确实是一个较为常见的事情。一般
来讲，每个图标代表一个正在运行的进程（或程序）。用鼠标点击这些图标，或弹出一个窗口或显示一个菜单
，用户可以对特定的任务进行设置和操作。Delphi可以编写只在系统状态栏显示一个图标的应用程序，并将应
用程序隐藏起来，不在任务栏和任务列表中显示。
1 托盘区组件TTrayIcon
对系统状态栏编程需要使用ShellApi中的Shell_NotifyIcon 函数和数据结构TNOTIFYICONDATA。另外还需要
一组Windows API函数来实现隐应用程序的主窗口。实际编写起来并非易事，为了简化应用，已有多个组件出
现，例如RX Library, TTrayIcon等。但是，当笔者试用之后，发现他们都存在不同程度的缺陷，就以
TTrayIcon组件的源码为基础进行了大量的改进，形成一个功能更加强大的组件, 现将其奉献给大家，源码如
下。
TrayIcon.Pas
unit TrayIcon;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls, ShellAPI, Forms,
Menus, ExtCtrls, Dialogs ;
const WM_TOOLTRAYICON = WM_USER+1;
WM_RESETTOOLTIP = WM_USER+2;
type
TTrayIcon = class(TComponent)
private
IconData: TNOTIFYICONDATA;
fAnimate : boolean ;
fAnimateInterval : integer ;
fCurrentImage : integer ;
fIcon : TIcon;
fOriginalIcon : TIcon ; // 保存原来的图标
fToolTip : String;
fWindowHandle : HWND;
fActive : boolean;
fShowDesigning : Boolean;
fTimer : TTimer ;
fOnClick : TNotifyEvent;
fOnDblClick : TNotifyEvent;
fOnRightClick : TMouseEvent;
fPopupMenu : TPopupMenu;
fImages : TImageList ;
fMainWin : TForm; // 保存主窗口
function AddIcon : boolean;
function ModifyIcon : boolean;
function DeleteIcon : boolean;
procedure SetActive(Value : boolean);
procedure SetAnimate(Value : boolean);
procedure SetAnimateInterval(Value : integer);
procedure SetShowDesigning(Value : boolean);
procedure SetIcon(Value : TIcon);
procedure SetToolTip(Value : String);
procedure SetMainWin(Value : TForm);
procedure WndProc(var msg : TMessage);
procedure FillDataStructure;
procedure DoRightClick( Sender : TObject );
procedure ChangeIcon( Sender : TObject ) ;
// onShow event handler for main window
procedure HideMainWin(Sender: TObject);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override ;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
published
property Active : boolean read fActive write SetActive default true;
property Animate : boolean read fAnimate write SetAnimate ;
property AnimateInterval : integer read fAnimateInterval write SetAnimateInterval
default 100;
property ShowDesigning : boolean read fShowDesigning write SetShowDesigning;
property Icon : TIcon read fIcon write SetIcon;
property Images : TImageList read fImages write fImages ;
property ToolTip : string read fTooltip write SetToolTip;
property MainWindow : TForm read fMainWin write SetMainWin;
property OnClick : TNotifyEvent read FOnClick write FOnClick;
property OnDblClick : TNotifyEvent read FOnDblClick write FOnDblClick;
property OnRightClick : TMouseEvent read FOnRightClick write FonRightClick;
property PopupMenu : TPopupMenu read fPopupMenu write fPopupMenu;
end;
procedure Register;
implementation
{$R TrayIcon.res}
procedure TTrayIcon.Notification(AComponent: TComponent; Operation: TOperation);
begin
if (AComponent = FImages) and (Operation = opRemove) then begin
Animate := False ;
FImages := nil ;
end ;
end;
procedure TTrayIcon.SetActive(Value : boolean);
begin
if value <> fActive then begin
fActive := Value;
if not (csdesigning in ComponentState) then begin
if Value then
AddIcon
else
DeleteIcon;
end;
end;
end;
procedure TTrayIcon.SetShowDesigning(Value : boolean);
begin
if csdesigning in ComponentState then begin
if value <> fShowDesigning then begin
fShowDesigning := Value;
if Value then
AddIcon
else
DeleteIcon ;
end;
end;
end;
procedure TTrayIcon.SetIcon(Value : Ticon);
begin
if Value <> fIcon then begin
fIcon.Assign(value);
ModifyIcon;
end;
end;
procedure TTrayIcon.SetAnimate(Value : boolean);
begin
if (not Value) or ((fImages <> nil) and (fImages.Count > 0) and fActive) then
begin
fAnimate := Value ;
if Value then begin
fOriginalIcon.Assign(fIcon) ;
fCurrentImage := 0 ;
end ;
fTimer.Enabled := Value ;
if not Value then
SetIcon(fOriginalIcon) ;
end ;
end ;
procedure TTrayIcon.SetAnimateInterval(Value : integer);
begin
if Value > 0 then begin
fAnimateInterval := Value ;
fTimer.Interval := Value ;
end ;
end ;
procedure TTrayIcon.SetToolTip(Value : string);
begin
if length( Value ) > 62 then
Value := copy(Value,1,62);
fToolTip := value;
ModifyIcon;
end;
procedure TTrayIcon.SetMainWin(Value : TForm);
var
AppIcon : TIcon;
begin
if (Value <> nil) then begin
fMainWin := Value;
AppIcon := TIcon.Create;
AppIcon.Handle := LoadIcon( HInstance ,pchar('MainIcon') );
Icon := AppIcon;
AppIcon.Free;
fMainWin.OnShow := HideMainWin;
end;
end;
constructor TTrayIcon.Create(AOwner : TComponent);
begin
inherited ;
FWindowHandle := AllocateHWnd( WndProc );
FIcon := TIcon.Create;
FOriginalIcon := TIcon.Create ;
FAnimateInterval := 100 ;
FTimer := TTimer.Create(self) ;
Active := True;
FTimer.Enabled := False ;
FTimer.OnTimer := ChangeIcon;
if Owner is TForm then begin
MainWindow := TForm(Owner);
Active := True;
end
else
MainWindow := nil;
ToolTip := 'TrayIcon1';
end;
destructor TTrayIcon.Destroy;
begin
if (not (csDesigning in ComponentState) and fActive)
or ((csDesigning in ComponentState) and fShowDesigning) then
DeleteIcon ;
FTimer.Free ;
FIcon.Free;
FOriginalIcon.Free ;
DeAllocateHWnd(FWindowHandle );
inherited ;
end;
procedure TTrayIcon.HideMainWin(Sender: TObject);
begin
if not (csDesigning in ComponentState) then begin
ShowWindow(Application.handle, SW_HIDE);
ShowWindowAsync(fMainWin.Handle, SW_HIDE );
SetWindowPos(fMainWin.Handle, HWND_BOTTOM, -500, 0, fMainWin.Width, fMainWin.Height,
SWP_HIDEWINDOW + SWP_NOSIZE);
end;
end;
procedure TTrayIcon.FillDataStructure;
begin
with IconData do begin
cbSize := sizeof(TNOTIFYICONDATA);
wnd := FWindowHandle;
uID := 0;
uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
hIcon := fIcon.Handle;
StrPCopy(szTip,fToolTip);
uCallbackMessage := WM_TOOLTRAYICON;
end;
end;
function TTrayIcon.AddIcon : boolean;
begin
FillDataStructure;
result := Shell_NotifyIcon(NIM_ADD,@IconData);
if fToolTip = '' then
PostMessage( fWindowHandle, WM_RESETTOOLTIP,0,0 );
end;
function TTrayIcon.ModifyIcon : boolean;
begin
FillDataStructure;
if fActive then
result := Shell_NotifyIcon(NIM_MODIFY,@IconData)
else
result := True;
end;
procedure TTrayIcon.DoRightClick( Sender : TObject );
var MouseCo: Tpoint;
begin
GetCursorPos(MouseCo);
if assigned( fPopupMenu ) then begin
SetForegroundWindow( Application.Handle );
Application.ProcessMessages;
fPopupmenu.Popup( Mouseco.X, Mouseco.Y );
end;
if assigned( FOnRightClick ) then
begin
FOnRightClick(self,mbRight,[],MouseCo.x,MouseCo.y);
end;
end;
function TTrayIcon.DeleteIcon : boolean;
begin
result := Shell_NotifyIcon(NIM_DELETE,@IconData);
end;
procedure TTrayIcon.WndProc(var msg : TMessage);
begin
with msg do
if (msg = WM_RESETTOOLTIP) then
SetToolTip( fToolTip )
else if (msg = WM_TOOLTRAYICON) then begin
case lParam of
WM_LBUTTONDBLCLK : if assigned (FOnDblClick) then FOnDblClick(self);
WM_LBUTTONUP : if assigned(FOnClick)then FOnClick(self);
WM_RBUTTONUP : DoRightClick(self);
end;
end
else // Handle all messages with the default handler
Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;
procedure TTrayIcon.ChangeIcon( Sender : TObject ) ;
var
TempIcon : TIcon ;
begin
TempIcon := TIcon.Create ;
if fCurrentImage = fImages.Count - 1 then
fCurrentImage := 0
else
Inc(fCurrentImage) ;
fImages.GetIcon(fCurrentImage, TempIcon) ;
SetIcon(TempIcon) ;
TempIcon.Free ;
end ;
procedure Register;
begin
RegisterComponents('Samples', [TTrayIcon]);
end;
end.
2 组件的安装与使用
2.1 组件的安装
首先将TrayIcon.Pas和TrayIcon.RES两个文件复制到C:\Program Files\Borland\Delphi5\UserLib\目录
（DELPHI默认的用户组件库目录）下。启动Delphi，单击"Component"菜单中的"Install Component"菜单命
令，弹出图 1所示的安装组件对话窗口。将"Unit file name"设置为"C:\Program
Files\Borland\Delphi5\UserLib\Trayicon.pas"或组件源文件所在的位置，将"Package file name"设置
为"c:\program files\borland\delphi5\userlib\UserLib.dpk"，单击"OK"按钮，DELPHI自动安装该组件
，并告诉你安装的结果。
图 1 安装组件对话窗口
2.2 使用说明
该组件的使用极其简单，当程序的主窗体建立好后，只需要简单地选中"Samples"组件页上的TrayIcon组件，
在窗体上放置一个"TrayIcon"组件，可看到如图 2所示的对象监视窗口，"MainWindow"属性已经自动设置成当
前的窗体了，而且"Icon"属性也设置成程序的默认图标。你需要做的是在主窗口上添加一个PopupMenu组件，
并在其中添加"Exit"、"Setup"和"Pause"等命令并编写相应的事件处理程序。然后，就可以编译运行这个简单
的示例程序。当程序图标在系统状态栏显示后，用鼠标右键单击该图标就可以显示一个弹出菜单，用来控制应
用程序。
图 2 对象监视窗口
3 小结
在使用DELPHI编程时，我们不妨将一些重复使用的常用代码组织起来，写成组件，放到DELPHI的组件板上，这
样，在使用时只需要将组件加到窗体上，并进行必要的设置，就可以完成特定的功能了，免去了重复拷贝代码
和修改类似代码的痛苦。该组件和示例程序在DELPHI 5.0＋WINDOWS 98环境下调试通过。
©董占山Zhanshan Dong
|
