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
    { Private declarations }
    //私有成员
  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
  { Protected declarations }
  //应用程序的消息钩子，获得主窗口的最小化消息
  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
    { Public declarations }
    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;
  published
    { Published declarations }
    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(‘Samples’, [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:=1800;
      placement.ptMinPosition.y:=1200;
      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.