Подклассы 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;
Затем процедура подкласса окна, как и положено, 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, каждый из которых применяет свой подкласс. Также я не могу знать порядок, в котором Delphi будет завершать юниты.
Подклассы удаляются в неправильном порядке, и при закрытии приложения происходит сбой.
как исправить? Как я могу гарантировать, что я продолжу свой метод подклассов достаточно долго, пока другой парень не выполнит после того, как я закончу? (Я не хочу, чтобы утечка памяти, в конце концов)
Смотри также
Обновление: Я вижу, Delphi 7 исправляет ошибку, переписав TApplication. > <</p>
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 исправил, когда они приняли TThemeManager Майка.
Это очень хорошо может означать, что нет способа удалить подклассы на TApplication в обратном порядке. Кто-то выразил это в форме ответа, и я приму его.