问题
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