Mike LischkeのTThemeServicesサブクラス。これにより、テーマが変更されたときにApplication.HandleWindows（つまり）からブロードキャスト通知を受信できるよう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がユニットをファイナライズする順序もわかりません。
サブクラスが間違った順序で削除されており、アプリケーションを閉じるとクラッシュします。
直し方？私が終わった後に他の人が完了するまで、サブクラス化メソッドを十分長く保つにはどうすればよいですか？（結局、メモリをリークしたくない）
も参照してください
更新： Delphi7はを書き直すことでバグを解決しているようです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
言い換えると、TApplicationをサブクラス化しようとするのはバグであり、BorlandはMikeのを採用したときに修正しましたTThemeManager。
TApplicationこれは、サブクラスを逆の順序で削除する方法がないことを意味している可能性があります。誰かがそれを答えの形で入れて、私はそれを受け入れます。