一个简单控件的编写--系统托盘

 在网上看到不少系统托盘的控件，有的写的东西太多，用不上，但大家似乎都没有解决一个问题，那就是单击和双击怎么处理的问题，所以自己也写了一个贴出来。希望大家能多提意见，如果哪个地方有不对的地方请指出，但千万别骂。

        这个控件很简单，可以用 Show 的方法显示图标，用 Hide 的方法来隐藏图标，可以处理单击和双击的事件，还有一个 Popup 菜单（在点击右键的时候弹出）。你也可以用Icon的属性更改图标，可以用Tip属性更改提示。

        这个控件的 OnClick 和 OnDblClick 处理的方法是这样的，如果只设置 OnClick 则是立即响应，如果这两者同时定义，则双击时只会响应 OnDblClick 而不会像普通控件那样，两者都响应。

{*******************************************************
       Borland Delphi 可视化组件库   系统托盘 Ver 1.0     
                                                       
            作者 ： 黄涛     Hunter@Shentong.com.cn

            2004年5月31日             
                                                      
*******************************************************}
unit NotifyIcon;

interface

uses
  Messages, Windows, SysUtils, Classes, shellapi,StrUtils,
  Forms, Menus, Graphics;
const  NotifyMsg = WM_USER+1;    //托盘自定义消息
type
  TNotifyIcon = class(TComponent)         //自TComponent 派生
  private
    FData: TnotifyIconData;                 //系统托盘所需的数据
    FEnabled: Bool;
    FOnClick: TNotifyEvent;       
    FOnDblClick: TNotifyEvent;
    FPopupMenu: TPopupMenu;
    FIcon: TIcon;                                  //托盘图标
    FTimer: Bool;
    FDblClickTime: Cardinal ;
    procedure SetEnabled(Flag: Bool);          
    procedure SetIcon(h: TICON);                
    procedure SetTip(s: string);
    function  GetTip: string;
    procedure WndProc(var Msg: TMessage);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Show;                                //显标图标
    procedure Hide;                                  //隐藏图标
  published
    property Handle: HWND read FData.Wnd;              //托盘的句柄
    property Enabled : Bool read FEnabled Write SetEnabled default False;     //显示或隐藏
    property OnClick : TNotifyEvent read FOnClick Write FOnClick;               //单击左键时响应
    property OnDblClick : TNotifyEvent read FOnDblClick Write FOnDblClick;   //双击左键时响应
    property PopupMenu : TPopupMenu read FPopupMenu Write FPopupMenu;  //单击右键时响应，弹出菜单
    property Icon : TICON read FIcon  Write SetIcon;                      // 图标
    property Tip : String read GetTip write settip ;                   //提示
  end;
procedure Register;

implementation

constructor TNotifyIcon.Create(AOwner: TComponent);           //构造函数，初始化变量
begin
  inherited Create(AOwner);
  FTimer := False;
  FDblClickTime := GetDoubleClickTime;           //获取双击时间间隔
  FEnabled := False;                                                
  FData.Wnd := Classes.AllocateHWnd(WndProc);   // 设置回调函数
  FData.cbSize := sizeof(TNotifyIconData);                   
  FData.uCallbackMessage :=NotifyMsg;              
  FData.szTip := '';
  FData.uID := UINT(self);
  FData.uFlags := nif_icon + nif_tip + nif_message;
  Icon := application.Icon ;                                     //默认初始化图标为主程序图标
end;

destructor TNotifyIcon.Destroy;                     //析构函数
begin
  if FEnabled then Enabled :=false;
  Classes.DeallocateHWnd(FData.Wnd);
  inherited Destroy;
end;

procedure TNotifyIcon.SetIcon(h:TICON) ;          //设置图标
begin
  FIcon := h;                                                                
  FData.hIcon := FIcon.Handle ;
  if Enabled then Shell_NotifyIcon(NIM_MODIFY,@FData);
end;

procedure TNotifyIcon.SetTip(s:string);       //设置提示语
begin
  if length(s)>63 then s:=midstr(s,1,63);           //最长为64字节，所以超过63字节需要截断
  strcopy(Fdata.szTip ,pchar(s));
  if Enabled then Shell_NotifyIcon(NIM_MODIFY,@FData);
end;

function TNotifyIcon.GetTip :string;           //获取提示语
begin
  Result := Fdata.sztip;
end;

procedure TNotifyIcon.Show ;         //在托盘显示图标
begin
  Enabled :=True;
end;

procedure TNotifyIcon.Hide ;          //隐藏图标
begin
  Enabled :=False;
end;

procedure TNotifyIcon.SetEnabled(Flag:Bool) ;         //显示或隐藏图标
begin
  if Flag = Fenabled then exit;
  if Flag then  shell_notifyicon(NIM_ADD,@FData)
  else   shell_notifyicon(NIM_Delete,@FData);
  FEnabled := not FEnabled;
end;

procedure TNotifyIcon.WndProc(var Msg: TMessage) ;    //回调函数
var p: TPoint;
begin
  if Msg.Msg = NotifyMsg then begin
    case msg.LParam  of
      WM_LBUTTONUP:begin                                //左键弹起，如果只定义OnClick 则立即响应
        if assigned(FOnClick) and not assigned(FOnDblClick) then OnClick(self);
      end;
      WM_LBUTTONDOWN:begin                 //左键落下，如果单击和双击同时定义，则启用定时器，
        if assigned(FOnClick) and assigned(FOnDblClick) then begin           //以判断是单击还是双击
          SetTimer(Handle,1,FDblClickTime,nil);                                      //如果不是同时定义则不响应
          FTimer :=True;
        end;
      end;
      WM_LBUTTONDBLCLK :begin               //左键双击，
        if FTimer then begin                                  //如果有定时器，则取消定时器
          KillTimer(Handle,1);
          FTimer:=False;
        end ;
        if assigned(FOnDblClick) then OnDblClick(self);   //如果定义双击则响应
      end;
      WM_RBUTTONUP : begin                            //右键弹起，响应菜单
        if assigned(FPopupMenu) then begin
          GetCursorPos(p);
          FPopupMenu.Popup(p.x,p.Y);
        end;
       end;
      end;
      msg.Result :=0;
  end else if msg.Msg = WM_TIMER then begin   //定时器结束，响应单击。
    KillTimer(Handle,1);                                          //在单击、双击同时定义的情况下，没有双击
    FTimer := False;
    FOnClick(self);
  end;
end;

procedure Register;
begin
  RegisterComponents('System', [TNotifyIcon]);
end;

end.