unit TrayIcon;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Menus, ShellAPI;type
  ENotifyIconError = class(Exception);
  TTrayNotifyIcon = class(TComponent)
  private
    { Private declarations }
    FDefaultIcon : THandle;
    FIcon : TIcon;
    FHideTask : Boolean;
    FHint : string;
    FIconVisible : Boolean;
    FPopupMenu : TPopupMenu;
    FOnClick : TNotifyEvent;
    FOnDblClick : TNotifyEvent;
    FNoShowClick : Boolean;
    FTimer : TTimer;
    Tnd : TNotifyIconData;
    procedure SetIcon(Value : TIcon);
    procedure SetHideTask(Value : Boolean);
    procedure SetHint(Value : string);
    procedure SetIconVisible(Value : Boolean);
    procedure SetPopupMenu(Value : TPopupMenu);
    procedure SendTrayMessage(Msg : DWORD; Flags : UINT);
    function ActiveIconHandle : THandle;
    procedure OnButtonTimer(Sender : TObject);
  protected
    { Protected declarations }
    procedure Loaded; override;
    procedure LoadDefaultIcon; virtual;
    procedure Notification(AComponent : TComponent; Operation : TOperation); override;
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property Icon : TIcon read FIcon write SetIcon;
    property HideTask : Boolean read FHideTask write SetHideTask default False;
    property Hint : string read FHint write SetHint;
    property IconVisible : Boolean read FIconVisible write SetIconVisible default False;
    property PopupMenu : TPopupMenu read FPopupMenu write SetPopupMenu;
    property OnClick : TNotifyEvent read FOnClick write FOnClick;
    property OnDblClick : TNotifyEvent read FOnDblClick write FOnDblClick;
  end;procedure Register;implementationprocedure Register;
begin
  RegisterComponents('MICHAEL', [TTrayNotifyIcon]);
end;{TIconManager}Type
  TIconManager = class
  private
    FHWindow : HWnd;
    procedure TrayWndProc(var Message : TMessage);
  public
    constructor Create;
    destructor Destroy; override;
    property HWindow : HWnd read FHWindow write FHWindow;
  end;var
  IconMgr : TIconManager;
  DDGM_TRAYICON : Integer;constructor TIconManager.Create;
begin
 FHWindow := AllocateHWnd(TrayWndProc);
end;destructor TIconManager.Destroy;
begin
  if FHWindow <> 0 then DeallocateHWnd(FHWindow);
  inherited Destroy;
end;procedure TIconManager.TrayWndProc(var Message : TMessage);
var
 pt : TPoint;
 TheIcon : TTrayNotifyIcon;
begin
 with Message do
 begin
  if (Msg = DDGM_TRAYICON) then
  begin
   TheIcon := TTrayNotifyIcon(WParam);
   case lParam of
    WM_LBUTTONDOWN : TheIcon.FTimer.Enabled := True;
    WM_LBUTTONDBLCLK :
      begin
        TheIcon.FNoShowClick := True;
        if Assigned(TheIcon.FOnDblClick) then TheIcon.FOnDblClick(self);
      end;
    WM_RBUTTONDOWN :
     begin
      if Assigned(TheIcon.FPopupMenu) then
      begin
        SetForegroundWindow(IconMgr.HWindow);
        GetCursorPos(Pt);
        TheIcon.FPopupMenu.Popup(Pt.X, Pt.Y);
        PostMessage(IconMgr.HWindow, WM_USER, 0, 0);
      end;
     end;
   end;
  end
 else
  Result := DefWindowProc(FHWindow, Msg, wParam, lParam);
 end;
end;{TTrayNotifyIcon}
constructor TTrayNotifyIcon.Create(AOwner : TComponent);
begin
 inherited Create(AOwner);
 FIcon := TIcon.Create;
 FTimer := TTimer.Create(self);
 with FTimer do
 begin
  Enabled := False;
  Interval := GetDoubleClickTime;
  OnTimer := OnButtonTimer;
 end;
 LoadDefaultIcon;
end;destructor TTrayNotifyIcon.Destroy;
begin
 if FIconVisible then SetIConVisible(False);
 FIcon.Free;
 FTimer.Free;
 inherited Destroy;
end;function TTrayNotifyIcon.ActiveIconHandle : THandle;
begin
 if (FIcon.Handle <> 0) then
   Result := FIcon.Handle
 else
   Result := FDefaultIcon;end;procedure TTrayNotifyIcon.LoadDefaultIcon;
begin
  FDefaultIcon := LoadIcon(0, IDI_WINLOGO);
end;procedure TTrayNotifyIcon.Loaded;
begin
 inherited Loaded;
 if FIconVisible then
  SendTrayMessage(NIM_ADD, NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;procedure TTrayNotifyIcon.Notification(AComponent : TComponent; Operation : TOperation);
begin
 inherited Notification(AComponent, Operation);
 if (Operation  = opRemove) and (AComponent = PopupMenu) then
   PopupMenu := nil;
end;procedure TTrayNotifyIcon.OnButtonTimer(Sender : TObject);
begin
 FTimer.Enabled := False;
 if (not FNoShowClick) and Assigned(FOnClick) then
   FOnClick(self);
 FNoShowClick := False;
end;procedure TTrayNotifyIcon.SendTrayMessage(Msg : DWORD; Flags : UINT);
begin
 with Tnd do
 begin
  cbSize := Sizeof(Tnd);
  StrPLCopy(szTip, PChar(FHINT), SizeOf(szTip));
  uFlags := FLags;
  uID := UINT(Self);
  Wnd := IconMgr.HWindow;
  uCallbackMessage := DDGM_TRAYICON;
  hIcon := ActiveIconHandle;
 end;
 Shell_NotifyIcon(Msg, @Tnd);
end;procedure TTrayNotifyIcon.SetHideTask(Value : Boolean);
const
  ShowArray : Array[Boolean] of integer = (sw_ShowNormal, sw_hide);
begin
 if FHideTask <> Value then
 begin
  FHideTask := Value;
  if not(csDesigning in ComponentState) then
   ShowWindow(Application.Handle, ShowArray[FHideTask]);
 end;
end;procedure TTrayNotifyIcon.SetHint(Value : String);
begin
 if FHint <> Value then
  begin
   FHint := Value;
   if FIconVisible then
    SendTrayMessage(NIM_MODIFY, NIF_TIP);
  end;
end;procedure TTrayNotifyIcon.SetIcon(Value : TIcon);
begin
 FIcon.Assign(Value);
 if FIconVisible then SendTraymessage(NIM_MODIFY, NIF_ICON);
end;procedure TTrayNotifyIcon.SetIconVisible(Value : Boolean);
const
  MsgArray : array[boolean] of DWORD = (NIM_DELETE, NIM_ADD);
begin
 if FIconVisible <> Value then
  begin
   FIconVisible := Value;
   SendTrayMessage(MsgArray[Value], NIF_MESSAGE or NIF_ICON or NIF_TIP);
  end;
end;procedure TTrayNotifyIcon.SetPopupMenu(Value : TPopupMenu);
begin
 FPopupMenu := Value;
 if Value <> nil then Value.FreeNotification(self);
end;const
  TraymsgStr = 'Michael.TrayNotifyIconMsg';initialization DDGM_TRAYICON := RegisterWindowMessage(TraymsgStr);
 IconMgr := TIconManager.Create;finalization
  IconMgr.Free;   end.//结束控件在win98下运行都正常,而在win2k或winnt下,如果程序在运行,
“开始”-->“关闭系统”时,无反应,无法关闭操作系统,必须把该
程序关闭后,才能退出操作系统,请高手帮我检查一下

解决方案 »

  1.   

    懒得检查了……你把WM_QUERYENDSESSION消息重载掉,万事大吉!一定不要忘了:Message.Result:=1
      

  2.   

    重载WM_QUERYENDSESSION消息,是与这个消息冲突了吗?
      

  3.   

    记得Delphi 5.0 带这个控件来者,怎么6.0里面找不到了?
      

  4.   

    up一下,我也写了一个你看一下:
      nid.cbSize := sizeof(nid); // nid变量的字节数
      nid.Wnd := Handle; // 主窗口句柄
      nid.uID := 1; // 内部标识,可设为任意数
      nid.hIcon := Application.Icon.Handle; // 要加入的图标句柄,可任意指
      nid.szTip := '光驱护理'; // 提示字符串
      nid.uCallbackMessage := MY_MESSAGE; // 回调函数消息
      nid.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE; // 指明哪些字段有
      if not Shell_NotifyIcon(NIM_ADD, @nid) then
      begin
      showwindow(application.Handle,sw_hide);
      end;
     setwindowlong(application.Handle,Gwl_exstyle,Ws_ex_toolwindow);
      

  5.   

    如何 重载WM_QUERYENDSESSION消息??
      

  6.   

    啥?如果上面的人不理解重载的含义。那就最好补补基础。override到底是什么意义。特别是楼主说的低级问题。