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;

子类化窗口procdure然后按照它应该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是唯一一个继承应用程序句柄的人。

我有一个类似的单身人士库，也想挂钩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的顺序，每个人都应用他们的子类。我也不知道德尔福最终确定单位的顺序。

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

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

另见

更新：我看到Delphi 7通过重写TApplication解决了这个问题。＆GT;＆LT;

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

GRRRR

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

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

Answer 1

也许您可以使用AllocateHWnd（）来分别接收相同的广播，而不是子类化TApplication窗口，因为它是它自己的顶级窗口。

Answer 2

我想我会做以下事情：

在ThemeSrv.pas。
在DwmSrv.pas的初始化部分中引用DwmServices（我猜你单位的名字）。

由于单位是按照初始化的顺序以相反的顺序最终确定的，因此您的问题将得到解决。

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

另见

4 个答案: