Delphi: How to remove subclasses in reverse order?

血红的双手。 提交于 2019-12-21 17:56:28

问题


Mike Lischke's TThemeServices subclasses Application.Handle, so that it can receive broadcast notifications from Windows (i.e. WM_THEMECHANGED) when theming changes.

It subclasses the Application object's window:

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;

The subclassed window procdure then does, as it's supposed to, WM_DESTROY message, remove it's subclass, and then pass the WM_DESTROY message on:

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;

The TThemeServices object is a singleton, destroyed during unit finalization:

initialization
finalization
  InternalThemeServices.Free;
end.

And that all works well - as long as TThemeServices is the only guy who ever subclasses the Application's handle.

i have a similar singleton library, that also wants to hook Application.Handle so i can receive broadcasts:

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);

And my singleton is similarly removed when the unit finalizes:

initialization
   ...
finalization
    InternalDwmServices.Free;
end.

Now we come to the problem. i can't guarantee the order in which someone might choose to access ThemeServices or DWM, each of which apply their subclass. Nor can i know the order in which Delphi will finalize units.

The subclasses are being removed in the wrong order, and there is a crash on application close.

How to fix? How can i ensure that i keep my subclassing method around long enough until the other guy is done after me is done? (i don't want to leak memory, after all)

See also

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

Update: i see Delphi 7 solves the bug by rewriting TApplication. ><

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

Grrrr

In other words: trying to subclass TApplication was a bug, that Borland fixed when they adopted Mike's TThemeManager.

That very well may mean that there is no way to remove subclasses on TApplication in reverse order. Someone put that in the form of an answer, and i'll accept it.


回答1:


Change your code to call SetWindowSubclass, as the article you linked to advises. But that only works if everyone uses the same API, so patch Theme Manager to use the same technique. The API was introduced in Windows XP, so there's no danger that it's not available on the systems where it would be needed.

There should be no problem with patching Theme Manager. It's designed to support Windows XP, which Microsoft doesn't support anymore, and to support Delphi 4 through 6, which Borland doesn't support anymore. Since development has ceased on all relevant products, it is safe for you to fork the Theme Manager project without risk of falling behind due to future updates.

You're not really introducing a dependency. Rather, you're fixing a bug that's only present when both window-appearance libraries are in use at the same time. Users of your library don't need to have Theme Manager for yours to work, but if they wish to use both, they need to use Theme Manager with your patches applied. There should be little objection to that since they already have the base version, so it's not like they'd be installing an entirely new library. They'd just be applying a patch and recompiling.




回答2:


Rather than subclassing the TApplication window, perhaps you can use AllocateHWnd() instead to receive the same broadcasts separately, since it is a top-level window of its own.




回答3:


I think I would do the following:

  • Put a reference to ThemeServices in the initialization section of ThemeSrv.pas.
  • Put a reference to DwmServices in the initialization section of DwmSrv.pas (I'm guess the name of your unit).

Since units are finalised in reverse order from the order of initialisation, your problem will be solved.




回答4:


Why don't you just use the ApplicationEvents and be done with it. No need to messing around with subclassing. The other way is to create only one subclass and create multi-notify events and subscribe as many as you wish.

Cheers



来源:https://stackoverflow.com/questions/4616535/delphi-how-to-remove-subclasses-in-reverse-order

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!