Question

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


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.

Was it helpful?

Solution

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.

OTHER TIPS

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.

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.

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

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top