尝试恢复托盘图标时出现 EOutOfResources 异常

Question

我在尝试实现代码以在资源管理器 crash/restart 后恢复托盘图标时遇到 EOutOfResources 异常 'Cannot remove shell notification icon'。我的代码基于找到的旧解决方案 here。试图隐藏托盘图标时发生异常。为什么下面的 Delphi XE 代码不起作用？

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, ExtCtrls;

type
  TForm1 = class(TForm)
    TrayIcon1: TTrayIcon;
    ImageListTray: TImageList;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  protected
    procedure WndProc(var Message: TMessage); Override;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  msgTaskbarRestart : Cardinal; {custom systemwide message}  

implementation

{$R *.dfm}

//ensure systray icon recreated on explorer crash
procedure TForm1.FormCreate(Sender: TObject);
begin
  msgTaskbarRestart := RegisterWindowMessage('TaskbarCreated');
end;

procedure TForm1.WndProc(var Message: TMessage);
begin
  if (msgTaskbarRestart <> 0) and (Message.Msg = msgTaskbarRestart) then begin 
    TrayIcon1.Visible := False; {Destroy the systray icon here}//EOutOfResources exception here
    TrayIcon1.Visible := True;  {Replace the systray icon}
    Message.Result := 1;
  end;
  inherited WndProc(Message);
end;

end.

Answer 1

当 NIM_DELETE 请求失败时，TTrayIcon.Visible 属性 setter 引发 EOutOfResources：

procedure TCustomTrayIcon.SetVisible(Value: Boolean);
begin
  if FVisible <> Value then
  begin
    FVisible := Value;
    ...

    if not (csDesigning in ComponentState) then
    begin
      if FVisible then
        ...
      else if not (csLoading in ComponentState) then
      begin
        if not Refresh(NIM_DELETE) then
          raise EOutOfResources.Create(STrayIconRemoveError); // <-- HERE
      end;
      ...
    end;
  end;
end;

其中 Refresh() 只是对 Win32 Shell_NotifyIcon() 函数的调用：

function TCustomTrayIcon.Refresh(Message: Integer): Boolean;
  ...
begin
  Result := Shell_NotifyIcon(Message, FData);
  ...
end;

当您收到 TaskbarCreated 消息时，您以前的图标不再出现在任务栏中，因此 Shell_NotifyIcon(NIM_DELETE) returns False。当（重新）创建任务栏时，您根本不应该尝试删除旧图标，只能根据需要使用 Shell_NotifyIcon(NIM_ADD) 重新添加新图标。

TTrayIcon 有一个 public Refresh() 方法，但是它使用 NIM_MODIFY 而不是 NIM_ADD，所以在这种情况下也不起作用:

procedure TCustomTrayIcon.Refresh;
begin
  if not (csDesigning in ComponentState) then
  begin
    ...
    if Visible then
      Refresh(NIM_MODIFY);
  end;
end;

但是，您实际上不需要在使用 TTrayIcon 时手动处理 TaskbarCreated 消息，因为它已经在内部为您处理了该消息，并且会调用 Shell_NotifyIcon(NIM_ADD)如果 Visible=True:

procedure TCustomTrayIcon.WindowProc(var Message: TMessage);
  ...
begin
  case Message.Msg of
    ...
  else
    if (Cardinal(Message.Msg) = RM_TaskBarCreated) and Visible then
      Refresh(NIM_ADD); // <-- HERE
  end;
end;

...

initialization
  ...
  TCustomTrayIcon.RM_TaskBarCreated := RegisterWindowMessage('TaskbarCreated');
end.

如果由于某种原因无法正常工作，and/or 您需要手动处理 TaskbarCreated，那么我建议直接调用受保护的 TCustomTrayIcon.Refresh() 方法，例如：

type
  TTrayIconAccess = class(TTrayIcon)
  end;

procedure TForm1.WndProc(var Message: TMessage);
begin
  if (msgTaskbarRestart <> 0) and (Message.Msg = msgTaskbarRestart) then begin 
    if TrayIcon1.Visible then begin
      // TrayIcon1.Refresh;
      TTrayIconAccess(TrayIcon1).Refresh(NIM_ADD);
    end;
    Message.Result := 1;
  end;
  inherited WndProc(Message);
end;

否则，根本不要使用 TTrayIcon。众所周知，它是越野车。多年来，我看到很多人对 TTrayIcon 有很多问题。我建议直接使用 Shell_NotifyIcon() 。我自己使用它从来没有遇到过任何问题。

尝试恢复托盘图标时出现 EOutOfResources 异常

EOutOfResources exception when trying to restore tray icon

delphi-xe

trayicon