Delphi中实现系统托盘的功能

如今的Delphi已经TTrayIcon控件直接支持系统托盘了，在这之前都需要写很多代码才能实现。

资料转自网络：http://hi.baidu.com/crazy_net/blog/item/2906203bc3e041ee15cecb93.html

 

unit jin01;

interface

uses

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

const

//自定义托盘消息

   WM_TrayMsg=WM_USER+10;

type

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

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

TMytaskTray=class(TComponent)

private

//私有成员

    FIcon:TIcon;   //图标

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

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

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

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

    FActive: Boolean; //是否启用托盘
    FPopupMenu: TPopupMenu;//弹出菜单

    FHint: string; //托盘提示字符串
    Ficonshow:BOOLean;//如果为true,显示托盘图标
    Ftkshow:BOOLean;//如果为TRUE，任务栏显示

    FRMode:TRMode; //恢复窗口的方式
    Fmenumode:TRMODE; //菜单弹出方式
    Fmousestat: integer;
    OldStyleEX: longInt;
    isClickIn: Boolean;//标识鼠标是否点在图标上

     //保存老的窗口风格

//事件成员

    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 SetPopupMenu( Value: TPopupMenu);
    procedure settkshow(value:boolean);
    procedure Seticonshow(value:boolean);

    procedure SetRMode(value:TRMode);
    procedure setmenumode(value:trmode);
     procedure taskhide;
     procedure taskshow;

//私有方法

procedure SetTray(Way:DWORD);
    function GetActiveIcon:THandle; //取得有用的图标句柄

protected

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

    function AppMsgHook(var Msg:TMessage):Boolean;
     //设置托盘样式,修改,删除,增加
    procedure formshowchange;

    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

     isMin:Boolean;//标识是否窗口最小化了
     constructor Create(AOwner:TComponent);override;

     destructor Destroy;override;
     procedure show;        //恢复窗口

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 tkshow:boolean read ftkshow write settkshow default false;
     property iconshow: boolean read Ficonshow write Seticonshow default true;

     property RMode:TRmode read FRmode write SetRMode default LDbClick;
      property menuMode:TRmode read Fmenumode write SetmenuMode default Rclick;
     property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
      procedure Notification(AComponent: TComponent; Operation: TOperation); override;

//事件的方法指针

     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('jinfei', [TMytaskTray]);

end;

///////////Tmytasktray////////////////////////////

constructor Tmytasktray.Create(AOwner:TComponent);

begin

inherited Create(AOwner);

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

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

   Application.HookMainWindow(AppMsgHook);

   FICon:=TICon.Create;

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

   FDfIcon:=Application.Icon.Handle;

   FSetDfIcon:=True;

   FActive:=False;
   Ficonshow:=true;
   ftkshow:=false;
   FRMode:=LDbClick;
   fmenumode:=Rclick;
   fmousestat:= WM_RBUTTONDOWN;

   isMin:=False;

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

    FHandle := AllocateHWnd(WndProc);

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

   // OldStyleEX:=GetWindowLong(Application.Handle,GWL_EXSTYLE);
   if not (csDesigning in ComponentState) and ftkshow=false then
         taskhide;

end;

destructor Tmytasktray.Destroy;

begin

Application.UnhookMainWindow(AppMsgHook);

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

    SetTray(NIM_DELETE);

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

DeallocateHWnd(FHandle);

FICon.Free;

inherited Destroy;

end;

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

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

var placement:WINDOWPLACEMENT;

begin

Result:=False;

//保证程序不会在设计时处理最小化消息
if factive then
begin
if not (csDesigning in ComponentState) then
begin
if (Msg.Msg=WM_SYSCOMMAND) then

begin

   if msg.WParam=SC_MINIMIZE Then

    begin

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

    //位置由SetWindowPlacement来决定
     OldStyleEX:=GetWindowLong(Application.Handle,GWL_EXSTYLE);
     ShowWindow(Application.Handle,SW_HIDE);
    if ftkshow=false then
     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);
      ismin:=true;
      end;
end;
end;
if ficonshow=false then
          SetTray(NIM_DELETE)
          else SetTray(NIM_ADD );

end
else
    settray(NIM_DELETE);

end;
//设置托盘方式,显示,修改,删掉,重要方法
procedure Tmytasktray.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;

//取得可用的图标

procedure Tmytasktray.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 Tmytasktray.SetDfIcon(Value:Boolean);

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;

procedure Tmytasktray.SetPopupMenu( Value: TPopupMenu);
begin
FPopupMenu := Value;
if Value <> nil then Value.FreeNotification(Self);
end;

procedure Tmytasktray.SetActive(Value:Boolean);

begin
   FActive:=Value;
    if not (csDesigning in ComponentState) then
         if factive=false then
          begin SetTray(NIM_DELETE);
       taskshow;
          end;

end;
procedure Tmytasktray.settkshow(value:boolean);
begin
        if factive=true then
        begin
           ftkshow:=value;
           if not (csDesigning in ComponentState) then
           if ftkshow=false then
             taskhide
            else
            taskshow;

         end;

end;

procedure Tmytasktray.SetHint(Value:String);

begin

     FHInt:=Value;

     if (IsMin)and(FActive) then

        SetTray(NIM_MODIFY);

end;
procedure Tmytasktray.Seticonshow(Value:Boolean);

begin
    if factive=true then
    begin
    Ficonshow:=Value;
      if ficonshow=false then
          SetTray(NIM_DELETE)
          else SetTray(NIM_ADD );
    end;
end;

procedure Tmytasktray.show;

begin
    if factive=true then
   formshowchange();

end;

procedure Tmytasktray.SetRMode(Value:TRMode);

begin

    FRmode:=Value;

end;

procedure Tmytasktray.SetmenuMode(Value:TRMode);

begin

    Fmenumode:=Value;
    case fmenumode of
   Lclick: fmousestat:=WM_LBUTTONdown;
   Ldbclick: fmousestat:=wm_LBUTTONDBLCLK;
   Rclick :   fmousestat:=Wm_rbuttondown;
   rdbclick: fmousestat:=WM_RBUTTONDBLCLK;
   end

end;

procedure Tmytasktray.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = fPopupMenu) then
    fPopupMenu := nil;
end;

function Tmytasktray.GetActiveIcon:THandle;

begin

   if not FSetDfIcon then

     result:=FIcon.Handle

   else

     result:=FDfIcon;

end;

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

procedure Tmytasktray.WndProc(var Msg: TMessage);

var p:TPoint;

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

begin
     if fmousestat=Msg.LParam then
         begin
          if Assigned(FPopupMenu) then
          begin
            SetForegroundWindow( FHandle); // 这句一定要加,否则弹出菜单不会自动隐藏
            GetCursorPos(P);
            FPopupMenu.Popup(P.X, P.Y);
          end;
          end;

    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

      formshowchange();

        end;

      end;

      WM_RBUTTONDBLCLK://右双击

      begin

        GetCursorPos(P);

        DblClick;

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

        if FRmode=RDbclick then

        begin

      formshowchange();

        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

          formshowchange();

          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

       formshowchange();

          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 tmytasktray.formshowchange;
begin
         
    if ismin=true then
        begin

            //    if ftkshow=false then
            //      taskhide;
              //    else
         // ShowWindow(Application.Handle,SW_SHOW);

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

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

         SetWindowLong(Application.Handle,GWL_EXSTYLE    ,OldStyleEX);

          SendMessage(Application.Handle,WM_SYSCOMMAND,SC_RESTORE,0);
           if ftkshow=false then
               taskhide;
              
           ismin:=false;
        end;
         
end;

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

procedure Tmytasktray.DblClick;

begin

if Assigned(FOnIconDblClick) then

    FOnIconDblClick(Self);

end;

procedure Tmytasktray.Click;

begin

if Assigned(FOnIconClick) then

    FOnIconClick(Self);

end;

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

begin

if Assigned(FOnIconMouseDown) then

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

end;

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

begin

if Assigned(FOnIconMouseUp) then

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

end;
procedure Tmytasktray.taskhide;
begin
ShowWindow(Application.Handle,SW_HIDE);
SetWindowLong(Application.Handle,GWL_EXSTYLE, WS_EX_TOOLWINDOW);

end;
procedure tmytasktray.taskshow;
begin
//SetWindowLong(Application.Handle,GWL_EXSTYLE    ,OldStyleEX);
// SendMessage(Application.Handle,WM_SYSCOMMAND,SC_RESTORE,0);
ShowWindow(Application.Handle,SW_SHOW);
SetWindowLong(Application.Handle,GWL_EXSTYLE, WS_EX_APPWINDOW);
end;
procedure Tmytasktray.MouseMove(Shift: TShiftState; X, Y: Integer);

begin

if Assigned(FOnIconMouseMove) then

    FOnIconMouseMove(Self, Shift, X, Y);

end;

end.