组件制作之五（托盘组件）

这将是最后一个组件了,目标定为非可视化,事实上非可视化组件要比可视化组件难做,因为是从TComponent继承而来,就没有了很多属性和事件。而这些都要我们从头来做过。

这个非可视化组件，我决定为托盘组件，其中用到的技术较多，我不如列一个表出来，然后再来讲解好一点。另外，可能篇幅会多一些，请耐心看。

用到的技术：

1作为核心功能，当然是托盘的应用啦。

2 托盘组件怎么样影响到主窗口最小化时隐藏

3 托盘如何处理消息

4 组件编辑器的用法

上面每一个技术都非常有趣，让我们一个个来看吧：

 

一  托盘，是系统壳编程的一个功能，相信我们也看过很多啦，大概知道它用起来是什么样子的。

那么它是如何实现的呢，

Windows定义了这样一个结构来存放托盘的信息：

typedef struct _NOTIFYICONDATA { // nid 

DWORD cbSize;

    HWND hWnd;

    UINT uID;

    UINT uFlags;

    UINT uCallbackMessage;

    HICON hIcon;

    char szTip[64];

} NOTIFYICONDATA, *PNOTIFYICONDATA;

cbSize是NOTIFYICONDATA结构的尺寸，我们一般用Sizeof就可以了

hWnd一个窗口句柄，用于检索托盘消息的。然而我们的非可视组件并没有窗口呀，这就是技术列表第三条要讲的，这里从略

uID 唯 一标识托盘图标的，我们可以随便指定一个数，但如果同时有不同的图标，则数应该不同

uFlags是NIF_ICON，NIF_MESSAGE，NIF_TIP中的一个或多个，我们全用就可以了。

uCallbackMessage;托盘消息，是我们自定义的消息，这里我们定义为：

                const

                  WM_TrayMsg=WM_USER+10;

hIcon托盘图标句柄

szTip这个是托盘提示，当托盘出现时，鼠标移到哪里，就会出现该提示。

Delphi将这个结构重定义为TNotifyIconData，我们照这个来用就行了

 

我们应用托盘要用到API函数Shell_NotifyIcon，其中有两个参数，第一个为

NIM_ADD，NIM_DELETE  ，NIM_MODIFY中的一个，分别表示添加托盘（图标出现）

修改托盘（比如图标，提示），删除（图标消失）第二个参数是NOTIFYICONDATA的指针

嗯，托盘应该差不多了。

 

二 这个组件能够决定主窗体最小化时，是否是正常最小化并没有托盘图标。还是最小化到屏幕之外，使我们看不见，且托盘区出现了图标。这里有一个成员为FActive来决定。

那么我们是怎么样影响到主窗体呢，也即怎么截获窗体的最小化消息呢。

全局变量Application有一个方法为procedure HookMainWindow(Hook: TWindowHook);

顾名思义，就是钩到主窗口的所有消息。里面的参数是TWindowHook类型，它是一个方法指针，定义如下：

type TWindowHook = function(var Message: TMessage): Boolean of object;

我们要自己定义过程的，然后传给HookMainWindow：

function AppMsgHook(var Msg:TMessage):Boolean;

Application.HookMainWindow(AppMsgHook);

这样做之后，主窗口的所有消息都会经过AppMsgHook方法啦，最小化消息也不例外，则我们可以在里面截获这个消息，并做一些操作：

 

做什么操作呢，先判断组件是否为设计时，如果是，不进行操作，如果不是进行下一步

if not (csDesigning in ComponentState) then

这样的意图是很明显的，因为当设计时的主窗其实是Delphi的IDE，如果让他处理该消息，其实是处理IDE的最小化消息，这时如果你最小化IDE，就会出现托盘啦。所以不能。

 

下一步是是否截获了最小化消息，以及FActive是否为真：

if (Msg.Msg=WM_SYSCOMMAND) and(FActive) then

两样都成立，执行里面的代码，代码中有解释，这里只说两个：

SetWindowLong(Application.Handle,GWL_EXSTYLE ,WS_EX_TOOLWINDOW);

设置了这个属性后,窗口最小化就不会停在任务栏了,而是停在屏幕的某个位置，这个位置在哪里呢，由

placement.flags:=WPF_SETMINPOSITION;

     placement.ptMinPosition.x:=1050;

     placement.ptMinPosition.y:=800;

     SetWindowPlacement(Application.Handle,@placement);

决定，具体的看代码，自己查帮助吧，这里不多说

 

而上说的设置SetWindowLong后，问题来了，窗口最小化的风格一变了，当你把Factive设为False，再最小化窗口，此时是没有托盘图标，但窗口还是最小化到屏幕的那个位置去了，我们看不到，又不能使其恢复（没有托盘）。怎么办呢，

原来还有一个GetWindowLong函数会返回当前风格的值，我们可以在控件的构造函数中这样调用

OldStyleEX:=GetWindowLong(Application.Handle,GWL_EXSTYLE);

这时，OldStyleEX:就保存了窗口原来最小化的风格了，窗口最小化，调用SetWindowLong，设置了新的最小风格。而当我们触发托盘事件，使窗体恢复大小时，我们在处理函数中调用

SetWindowLong(Application.Handle,GWL_EXSTYLE ,OldStyleEX);

这样，窗口又回到了原来的风格，这时我们设Factive为False，则窗口就能正常最小化了。

 

到控件被释放时，我们一定要调用Application.UnhookMainWindow(AppMsgHook);来解除钩子

 

其实这里也有一个不完善的地方，应该再设一个成员变量，确定设置托盘时，窗口是正常最小化，还是最小化到看不见。而我没有这么做，直接如果FActive为True，最小化会出现托盘图标，并且窗口最小化到看不见。不过影响不大，有兴趣的朋友看了之后可以帮我完善一下，也当做自己的练习吗。

 

三 托盘如果处理消息，上面说到，要设置托盘结构，一定要有一个窗口句柄，才能检索托盘消息，那么这个句柄是什么呢，非可视组件没有窗口句柄呀。

 

如果你有看过TTimer的源码，一定知道这一句代码：

FWindowHandle := AllocateHWnd(WndProc);

它创建一个看不见的窗口，返回他的句柄，并指定WndProc为窗口的消息处理过程

我们何不效仿它呢。

于是也定义一个成员句柄：

FHandle: HWnd;

把该句柄赋给NOTIFYICONDATA的hWnd字段

再定义一个消息处理过程：

procedure WndProc(var Msg: TMessage);

再在组件构造函数中：

FHandle := AllocateHWnd(WndProc);

如此之后，组件就可以截获托盘的消息了，并在WndProc过程中作相应处理。这里有必要对托盘的自定义消息做一个介绍：

我们自定义了这个消息WM_TrayMsg，它的lParam与托盘的uID相同，wParam是鼠标在图标上发生的事件消息，比如单击，双击等。

我们就要把这些消息转化为事件，供给用户处理，所以定义几个事件调度函数：

//以下为事件的调度函数

    procedure DblClick; dynamic;

    procedure Click; 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;

意思很明显，不多说，

当然也有几个事件方法指针：

FOnIconClick: TNotifyEvent;

FOnIconDblClick: TNotifyEvent;

FOnIconMouseMove: TMouseMoveEvent;

FOnIconMouseDown: TMouseEvent;

FOnIconMouseUp: TMouseEvent;

然后在WndProc中判断消息，并调用相应的事件调度函数。看代码吧，有解释。

 

好了，三个技术解决了，第四个呢，还是等代码出来以后再加组件编辑器吧。以下是源代码：

 

unit MyTray;

 

interface

 

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls,

  Forms, Dialogs, ShellApi, ExtCtrls,StdCtrls;

 

const

//自定义托盘消息

   WM_TrayMsg=WM_USER+10;

 

type

 //恢复窗口的方式，左双击，右双击，左单击，右双击

  TRMode=(LDbClick,RDbClick,LCLick,RClick);

 

  TMyTray=class(TComponent)

  private

  //私有成员

    FIcon:TIcon;   //图标

    FDfIcon:THandle; //应用程序的默认图标

    FSetDfIcon:Boolean; //是否用应用程序的图标，如果为True，则Ficon为nil

    FIconData: TNotifyIconData;  //托盘数据结构

    isMin:Boolean;//标识是否窗口最小化了

    FHandle: HWnd;  //不可视建窗体句柄,用于处理托盘事件

    FActive: Boolean;  //是否启用托盘

    FHint: string;  //托盘提示字符串

    FRMode:TRMode; //恢复窗口的方式

    isClickIn:Boolean;//标识鼠标是否点在图标上

    OldStyleEX:longInt; //保存老的窗口风格

  //事件成员

    FOnIconClick: TNotifyEvent;

    FOnIconDblClick: TNotifyEvent;

    FOnIconMouseMove: TMouseMoveEvent;

    FOnIconMouseDown: TMouseEvent;

    FOnIconMouseUp: TMouseEvent;

  //设置方法

    procedure SetIcon(value:TIcon);

    procedure SetDfIcon(value:boolean);

    procedure SetActive(value:boolean);

    procedure SetHint(value:string);

    procedure SetRMode(value:TRMode);

  //私有方法

    procedure SetTray(Way:DWORD);  //设置托盘样式,修改,删除,增加

    function GetActiveIcon:THandle; //取得有用的图标句柄

  protected

    //应用程序的消息钩子，获得主窗口的最小化消息

    function AppMsgHook(var Msg:TMessage):Boolean;

    procedure WndProc(var Msg: TMessage);//不可视窗口的窗口过程

    //以下为事件的调度函数

    procedure DblClick; dynamic;

    procedure Click; 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;

  public

     constructor Create(AOwner:TComponent);override;

     destructor  Destroy;override;

  published

     property Active:Boolean read FActive write SetActive default False;

     property Icon:TIcon read FIcon write SetICon;

     property SetDfIconed: boolean read FSetDfIcon write SetDfIcon default true;

     property Hint:String read FHint write SetHint;

     property RMode:TRmode read FRmode write SetRMode default LDbClick;

  //事件的方法指针

     property OnIconClick: TNotifyEvent read FOnIconClick write FOnIconClick;

     property OnIconDblClick: TNotifyEvent read FOnIconDblClick write FOnIconDblClick;

     property OnIconMouseMove: TMouseMoveEvent read FOnIconMouseMove write FOnIconMouseMove;

     property OnIconMouseDown: TMouseEvent read FOnIconMouseDown write FOnIconMouseDown;

     property OnIconMouseUp: TMouseEvent read FOnIconMouseUp write FOnIconMouseUp;

  end;

 

procedure Register;

 

implementation

 

procedure Register;

begin

  RegisterComponents('Wind', [TMyTray]);

end;

 

///////////TmyTray////////////////////////////

constructor TMyTray.Create(AOwner:TComponent);

begin

  inherited Create(AOwner);

  //设置程序钩子,指定AppMsgHook为处理函数,

  //则,应用程序的任何消息都将经过这个函数

   Application.HookMainWindow(AppMsgHook);

   FICon:=TICon.Create;

   //得到默认图标的句柄，图标为应用程序的图标

   FDfIcon:=Application.Icon.Handle;

   FSetDfIcon:=True;

   FActive:=False;

   FRMode:=LDbClick;

   isMin:=False;

  //创建一个不可视窗口，并指定窗口过程，以处理托盘事件

    FHandle := AllocateHWnd(WndProc);

  //保存窗体的老的风格,在恢复窗口的同时也恢复原来的窗口风格

    OldStyleEX:=GetWindowLong(Application.Handle,GWL_EXSTYLE);

end;

 

destructor TMyTray.Destroy;

begin

  Application.UnhookMainWindow(AppMsgHook);

  //对象释放之前先消除托盘

    SetTray(NIM_DELETE);

  //释放不可能窗口的句柄

  DeallocateHWnd(FHandle);

  FICon.Free;

  inherited Destroy;

end;

//应用程序钩子,可以截获应用程序的所有消息

function TMyTray.AppMsgHook(var Msg:TMessage):Boolean;

var placement:WINDOWPLACEMENT;

begin

 Result:=False;

 //保证程序不会在设计时处理最小化消息

 if not (csDesigning in ComponentState) then

 if (Msg.Msg=WM_SYSCOMMAND) and(FActive) then

 begin

   if msg.WParam=SC_MINIMIZE Then

    begin

    //设置了这个属性后,窗口最小化就不会停在任务栏了,而是停在屏幕,

    //位置由SetWindowPlacement来决定

     ShowWindow(Application.Handle,SW_HIDE);

     SetWindowLong(Application.Handle,GWL_EXSTYLE      ,WS_EX_TOOLWINDOW);

     GetWindowPlacement(Application.Handle,@placement);

     placement.flags:=WPF_SETMINPOSITION;

     placement.ptMinPosition.x:=1050;

     placement.ptMinPosition.y:=800;

     SetWindowPlacement(Application.Handle,@placement);

     SetTray(NIM_ADD );

   end;

 end;

end;

 

procedure TMyTray.SetIcon(Value:TIcon);

begin

   FIcon.Assign(Value);

   FsetDfIcon:=False; //有了自定义的图标,则默认图标自动设为False

   if FIcon.Empty then

    FsetDfIcon:=True;

   if (isMin)and(Factive) then

     SetTray(NIM_MODIFY );

end;

//设置是否为默认图标,与FIcon为互相的变量,只能有其中一个

procedure TMyTray.SetDfIcon(Value:Boolean);

begin

  if FSetDfIcon<>Value then

  begin

    FSetDfIcon:=Value;

    if not FSetDfIcon then

    begin

      if FIcon.Empty then begin

        FSetDfIcon:=True;

        exit;

      end;

    end

    else begin

        if (IsMin)and(FActive) then

         SetTray(NIM_MODIFY);

    end;

  end;

end;

 

procedure TMyTray.SetActive(Value:Boolean);

begin

  if FActive<>Value then

  begin

    FActive:=Value;

  end;

end;

 

procedure TMyTray.SetHint(Value:String);

begin

   if FHint<>Value then

   begin

     FHInt:=Value;

     if (IsMin)and(FActive) then

        SetTray(NIM_MODIFY);

   end;

end;

 

procedure TMyTray.SetRMode(Value:TRMode);

begin

  if FRmode<>Value then

    FRmode:=Value;

end;

//设置托盘方式,显示,修改,删掉,重要方法

procedure TMyTray.SetTray(Way:DWORD);

begin

   FIconData.cbSize:=Sizeof(FIconData);

   FIconData.Wnd:=FHandle;

   FIConData.uID:=0;

   FIConData.uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP;

   FIConData.uCallbackMessage:=WM_TrayMsg;

   FIConData.hIcon:=GetActiveIcon;

   StrLCopy(FIConData.szTip,Pchar(FHint),63);

   Shell_NotifyIcon(Way,@FIconData);

end;

//取得可用的图标

function TMyTray.GetActiveIcon:THandle;

begin

   if not FSetDfIcon then

     result:=FIcon.Handle

   else

     result:=FDfIcon;

end;

//托盘消息的截获,以调用相应的事件调度方法

procedure TMyTray.WndProc(var Msg: TMessage);

var p:TPoint;

begin

  if (Msg.Msg=WM_TrayMsg)and(FActive) then

  begin

    case Msg.LParam of

      WM_LBUTTONDBLCLK://左双击

      begin

        GetCursorPos(p);

        DblClick;

        MouseDown(mbLeft, KeysToShiftState(TWMMouse(Msg).Keys)+[ssDouble], P.X, P.Y);

        if FRmode=LDbclick then

        begin

          ShowWindow(Application.Handle,SW_SHOW);

          //这里很重要的一个就是恢复窗口风格,不然下次把Active设为True

          //最小化后,窗口依然会往左下角飞去,而托盘图标却看不见了.

          SetWindowLong(Application.Handle,GWL_EXSTYLE    ,OldStyleEX);

          SendMessage(Application.Handle,WM_SYSCOMMAND,SC_RESTORE,0);

          SetTray(NIM_DELETE);

        end;

      end;

      WM_RBUTTONDBLCLK://右双击

      begin

        GetCursorPos(P);

        DblClick;

        MouseDown(mbRight, KeysToShiftState(TWMMouse(Msg).Keys)+[ssDouble], P.X, P.Y);

        if FRmode=RDbclick then

        begin

          ShowWindow(Application.Handle,SW_SHOW);

          SetWindowLong(Application.Handle,GWL_EXSTYLE    ,OldStyleEX);

          SendMessage(Application.Handle,WM_SYSCOMMAND,SC_RESTORE,0);

          SetTray(NIM_DELETE );

        end;

      end;

      WM_MOUSEMOVE: //鼠标移动

      begin

        GetCursorPos(P);

        MouseMove(KeysToShiftState(TWMMouse(Msg).Keys), P.X, P.Y);

      end;

      WM_LBUTTONDOWN: //左单击下

      begin

        GetCursorPos(P);

        IsClickIn:=True;

        MouseDown(mbLeft, KeysToShiftState(TWMMouse(Msg).Keys) + [ssLeft], P.X, P.Y);

      end;

      WM_LBUTTONUP:  //左单击弹起

      begin

        GetCursorPos(P);

        if IsClickIn then

        begin

          IsClickIn:=False;

          Click;

          if FRmode=LClick then

          begin

            ShowWindow(Application.Handle,SW_SHOW);

            SetWindowLong(Application.Handle,GWL_EXSTYLE ,OldStyleEX);

            SendMessage(Application.Handle,WM_SYSCOMMAND,SC_RESTORE,0);

            SetTray(NIM_DELETE );

          end;

        end;

          MouseUp(mbLeft, KeysToShiftState(TWMMouse(Msg).Keys)+ [ssLeft], P.X, P.Y);

      end;

      WM_RBUTTONDOWN: //右单击下

      begin

        GetCursorPos(P);

        IsClickIn:=True;

        MouseDown(mbRight, KeysToShiftState(TWMMouse(Msg).Keys) + [ssRight], P.X, P.Y);

      end;

      WM_RBUTTONUP: //右单击弹起

      begin

        GetCursorPos(P);

        if IsClickIn then

        begin

          IsClickIn:=False;

          Click;

          if FRmode=RClick then

          begin

            ShowWindow(Application.Handle,SW_SHOW);

            SetWindowLong(Application.Handle,GWL_EXSTYLE ,OldStyleEX);

            SendMessage(Application.Handle,WM_SYSCOMMAND,SC_RESTORE,0);

            SetTray(NIM_DELETE );

          end;

        end;

        MouseUp(mbRight, KeysToShiftState(TWMMouse(Msg).Keys)+ [ssRight], P.X, P.Y);

       end;

      end;

  end

  else

     Msg.Result := DefWindowProc(FHandle, Msg.Msg, Msg.wParam, Msg.lParam);

end;

//以下为几个事件的调度函数,比较简单.

procedure TMyTray.DblClick;

begin

  if Assigned(FOnIconDblClick) then

    FOnIconDblClick(Self);

end;

 

procedure TMyTray.Click;

begin

  if Assigned(FOnIconClick) then

    FOnIconClick(Self);

end;

 

procedure TMyTray.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

  if Assigned(FOnIconMouseDown) then

    FOnIconMouseDown(Self, Button, Shift, X, Y);

end;

 

procedure TMyTray.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

  if Assigned(FOnIconMouseUp) then

    FOnIconMouseUp(Self, Button, Shift, X, Y);

end;

 

procedure TMyTray.MouseMove(Shift: TShiftState; X, Y: Integer);

begin

  if Assigned(FOnIconMouseMove) then

    FOnIconMouseMove(Self, Shift, X, Y);

end;

 

end.

 

组制作完毕，相信经过上面的讲解，以及代码的注释，应该不难理解。接下来是什么呢，给我的托盘控件来点效果，即在设计器中，当双击该组件，或右击快捷菜单第一项时，会弹出一个About对话框，来说明我的托盘组件。

这个就要用到组件编辑器啦 。几本经典书中都有说及，比如Deplphi开发人员指南，我也是从那里学来的，不过却遇到了一些问题，折磨了几天才解决。

这里不想详细介绍，去看一下那些书，大概也就知道了，只略说一下。

其原理就是实现一个继承自TComponentEditor的子类TTrayIconEditor，并在其中覆盖以下三个方法：

function GetVerbCount: Integer; override;

function GetVerb(Index: Integer): string; override;

procedure ExecuteVerb(Index: Integer); override;

可以精略理解为：

GetVerbCount指定控件快捷菜单的项数

GetVerb指定快捷菜单中的相关项的名字

ExecuteVerb执行点击快捷菜单项后的动作

 

接着在Register方法中调用RegisterComponentEditor(TMyTray,TTrayIconEditor);

第一个参数为组件类名，第二个为组件编辑器的类名。

而上面的方法必须引用DesignIntf,DesignEditors。

 

当我在我的组件单元这样做之后出现问题了，编译安装没有问题。我建立测试程序，并拉一个托盘组件，双击它，可以出现About对话框，右击菜单第一项也没有问题。可是当我运行测试程序时，却出现了这样的编译错误：

[Fatal Error] Unit1.pas(7): File not found: 'DesignEditors.dcu'

 

这让我痛苦了好几天，书上是这么说的，应该没有什么错误呀。后来经过摸索，才找到了解决之道。

解决的办法就是将组件编辑器类放在另一个单元中，并在这个单元引用我的托盘组件单元。

并安装之。这才可以正常运行，这个编辑器单元如下：

 

unit AboutTray;

 

interface

 

uses

  SysUtils,Classes,DesignIntf,DesignEditors,Forms,

  MyTray;

 

type

 TTrayIconEditor = class (TComponentEditor)

    function GetVerbCount: Integer; override;

    function GetVerb(Index: Integer): string; override;

    procedure ExecuteVerb(Index: Integer); override;

  end;

 

procedure Register;

 

implementation

 

///////TTrayIconEditor////////////////////////

procedure TTrayIconEditor.ExecuteVerb(index:integer);

begin

 case index of

 0: application.MessageBox('你好,这是风做的托盘组件!!','关于');

 end;

end;

 

function TTrayIconEditor.GetVerb(index:integer):String;

begin

  case index of

    0:Result:='About MyTray';

  end;

end;

 

function TTrayIconEditor.GetVerbCount:integer;

begin

  Result:=1;

end;

 

 

procedure Register;

begin

  RegisterComponentEditor(TMyTray,TTrayIconEditor);

end;

 

end.

 

至此，托盘组件完毕，拉下它放在窗体设计器中，双击，弹出对话框

里面内容为：“你好,这是风做的托盘组件!!”。哈哈，你成功啦

 

 

做为组件制作的最后一个内容，我想用一个包来把我的所有组件单元包含起来，并放在我自己新建的一个面板中。

这样做之前，要把以前安装下去的组件删除。知道怎么样删除，如果不知道，请看我在第一篇中说的。

然后在打开所有的组件单元，把RegisterComponents(‘Samples', [TCoolMemo]);里面的

Samples改为Wind。然后保存

接着，在IDE中点File－》New－》Other…

弹出来的New Items对话框，选中New页面，并选中其中的Package，

这里弹出一个新建的包编辑器。

先在IDE中点File－》Save。将包编辑器保存。保存在组件的单元所在的文件夹中

我的所有组件单元都放在Delphi7/MyCom文件夹中。因此这个包当然也保存在这里。

 

然后，点包编辑器上边的Add，将所有的组件单元加进去，当然也保括上面说的组件编辑器单元啦。

加进去后，点包编辑器上边的Compile，编译完毕，再点Insall。

成功，看看面板。所有以前做过的组件全在Wind面板中了。

而这时候，我的任务也完毕了。

 

 

结语

 

这次的组件之旅终于走完了，也许有人会笑我浅薄，认为这么简单的东西，有必要拿出来么。也许是比较简单吧，但一定有人会需要的，相信我的文章会给他们帮助的。因为这些是我曾经学到的知道，遇到的问题并解决它。所以我个人觉得是很珍贵的。并且经过写这几篇，我把这些知识记得更牢了。这种利己利人的事，何乐而不为呀。

在此，谢谢大家的阅读，也许下次还有机会再见面，不过现在要说再见了。祝你们愉快。