本站目录

首页
ASP/Access/IIS
DELPHI/PASCAL
PASCAL高级编程
C语言编程实例
WORD
Excel
MATLAB
MINITAB讲座
Windows
DOS
SAS
生物系统模拟
土壤水分剖析器
其他

镜像站点

主站
北美镜象站
欧洲镜象站(1)
欧洲镜象站(2)

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环境下调试通过。