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.
