Delphi:如何以相反的顺序删除子类？

Question

Mike Lischke 的 TThemeServices 子类 Application.Handle，以便在主题更改时可以接收来自 Windows 的广播通知(即 WM_THEMECHANGED)。

它是 Application 对象窗口的子类:

FWindowHandle := Application.Handle;
if FWindowHandle <> 0 then
begin
 // If a window handle is given then subclass the window to get notified about theme changes.
 {$ifdef COMPILER_6_UP}
    FObjectInstance := Classes.MakeObjectInstance(WindowProc);
 {$else}
    FObjectInstance := MakeObjectInstance(WindowProc);
 {$endif COMPILER_6_UP}
 FDefWindowProc := Pointer(GetWindowLong(FWindowHandle, GWL_WNDPROC));
 SetWindowLong(FWindowHandle, GWL_WNDPROC, Integer(FObjectInstance));
end;

子类化的窗口过程然后按照预期执行 WM_DESTROY 消息，删除其子类，然后将 WM_DESTROY 消息传递给:

procedure TThemeServices.WindowProc(var Message: TMessage);
begin
  case Message.Msg of
     WM_THEMECHANGED:
        begin
               [...snip...]
        end;
     WM_DESTROY:
        begin
          // If we are connected to a window then we have to listen to its destruction.
          SetWindowLong(FWindowHandle, GWL_WNDPROC, Integer(FDefWindowProc));
          {$ifdef COMPILER_6_UP}
             Classes.FreeObjectInstance(FObjectInstance);
          {$else}
             FreeObjectInstance(FObjectInstance);
          {$endif COMPILER_6_UP}
          FObjectInstance := nil;
        end;
  end;

  with Message do
     Result := CallWindowProc(FDefWindowProc, FWindowHandle, Msg, WParam, LParam);
end;

TThemeServices 对象是一个单例，在单元终结期间被销毁:

initialization
finalization
  InternalThemeServices.Free;
end.

一切都运行良好 - 只要 TThemeServices 是唯一对应用程序句柄进行子类化的人。

我有一个类似的单例库，它也想 Hook Application.Handle 这样我就可以接收广播:

procedure TDesktopWindowManager.WindowProc(var Message: TMessage);
begin
case Message.Msg of
WM_DWMCOLORIZATIONCOLORCHANGED: ...
WM_DWMCOMPOSITIONCHANGED: ...
WM_DWMNCRENDERINGCHANGED: ...
WM_DESTROY:
    begin
        // If we are connected to a window then we have to listen to its destruction.
        SetWindowLong(FWindowHandle, GWL_WNDPROC, Integer(FDefWindowProc));
        {$ifdef COMPILER_6_UP}
        Classes.FreeObjectInstance(FObjectInstance);
        {$else}
        FreeObjectInstance(FObjectInstance);
        {$endif COMPILER_6_UP}
        FObjectInstance := nil;
    end;
end;

with Message do
    Result := CallWindowProc(FDefWindowProc, FWindowHandle, Msg, WParam, LParam);

当单元完成时，我的单例也会被类似地删除:

initialization
   ...
finalization
    InternalDwmServices.Free;
end.

<小时/>

现在我们来解决问题了。我无法保证某人可能选择访问 ThemeServices 或 DWM 的顺序，每个都应用其子类。我也不知道 Delphi 最终确定单元的顺序。

子类被以错误的顺序删除，并且应用程序关闭时发生崩溃。

如何解决？我怎样才能ensure that i keep my subclassing method around long enough until the other guy is done我完成后？ (毕竟我不想泄漏内存)

另请参阅

• Raymond Chen: Safer Subclassing
• MSDN: Using Window Procedures
• Raymond Chen: When the normal window destruction messages are thrown for a loop

<小时/>

更新:我看到 Delphi 7 通过重写 TApplication 解决了该错误。 ><

procedure TApplication.WndProc(var Message: TMessage);
...
begin
   ...
   with Message do
      case Msg of
      ...
      WM_THEMECHANGED:
          if ThemeServices.ThemesEnabled then
              ThemeServices.ApplyThemeChange;
      ...
   end;
   ...
end;

咕噜咕噜

换句话说:尝试子类化 TApplication 是一个错误，Borland 在采用 Mike 的 TThemeManager 时修复了该错误。

这很可能意味着无法以相反的顺序删除 TApplication 上的子类。有人以答案的形式提出了这个问题，我会接受。

Answer 1

更改您的代码以调用 SetWindowSubclass ，正如您链接到的文章所建议的那样。但这只有在每个人都使用相同的 API 时才有效，因此请修补主题管理器以使用相同的技术。该 API 是在 Windows XP 中引入的，因此不存在在需要它的系统上不可用的危险。

给主题管理器打补丁应该没有问题。它旨在支持 Windows XP(Microsoft 不再支持)，以及支持 Delphi 4 到 6(Borland 不再支持)。由于所有相关产品的开发都已停止，因此您可以安全地 fork 主题管理器项目，而不会因 future 的更新而面临落后的风险。

您并没有真正引入依赖项。相反，您正在修复仅在同时使用两个窗口外观库时才会出现的错误。您的库的用户不需要主题管理器即可工作，但如果他们希望同时使用两者，则需要在应用了您的补丁后使用主题管理器。对此应该没有什么异议，因为他们已经有了基本版本，所以他们不会安装一个全新的库。他们只是应用补丁并重新编译。