Pergunta

Mike Lischke's TThemeServices subclasses Application.Handle, para que possa receber notificações de transmissão do Windows (ou seja, WM_THEMECHANGED) quando o tema muda.

Subclasse o Application Janela do objeto:

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;

A procedia de janela subclassem então faz, como deveria, WM_DESTROY mensagem, remova sua subclasse e depois passe o WM_DESTROY mensagem em:

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;

o TThemeServices Objeto é um singleton, destruído durante a finalização da unidade:

initialization
finalization
  InternalThemeServices.Free;
end.

E tudo funciona bem - desde que o TheMeServices seja o único cara que já subclasse o identificador do aplicativo.

Eu tenho uma biblioteca singleton semelhante, que também quer conectar Application.Handle Para que eu possa receber transmissões:

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);

E minha Singleton é removido da mesma forma quando a unidade finaliza:

initialization
   ...
finalization
    InternalDwmServices.Free;
end.

Agora chegamos ao problema. Não posso garantir a ordem em que alguém pode optar por acessar ThemeServices ou DWM, cada um dos quais aplica sua subclasse. Nem posso saber a ordem em que Delphi finalizará as unidades.

As subclasses estão sendo removidas na ordem errada e há um acidente no aplicativo fechar.

Como consertar? Como posso Certifique -me de manter meu método de subclassificação por tempo suficiente até que o outro O cara terminou depois de mim terminar? (eu não quero vazar memória, afinal)

Veja também


Atualizar: Eu vejo Delphi 7 resolve o bug reescreindo 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

Em outras palavras: Tentar subclasse Tapplication era um bug, que Borland corrigiu quando eles adotaram o Mike's TThemeManager.

Isso muito bem pode significar que não há como remover subclasses TApplication Em ordem inversa. Alguém colocou isso na forma de uma resposta, e eu aceitarei.

Foi útil?

Solução

Altere seu código para ligar SetWindowSubclass, como o artigo que você vinculou a aconselhar. Mas isso só funciona se todos usarem a mesma API, portanto, o gerente de temas de patch para usar a mesma técnica. A API foi introduzida no Windows XP, portanto, não há perigo de que não esteja disponível nos sistemas em que seria necessário.

Não deve haver problema em patching gerente de temas. Ele foi projetado para oferecer suporte ao Windows XP, que a Microsoft não suporta mais e para suportar o Delphi 4 a 6, que Borland não suporta mais. Como o desenvolvimento cessou em todos os produtos relevantes, é seguro você gastar o projeto do gerente de temas sem o risco de ficar para trás devido a atualizações futuras.

Você não está realmente introduzindo uma dependência. Em vez disso, você está corrigindo um bug que só está presente quando as duas bibliotecas de aparência de janelas estão em uso ao mesmo tempo. Os usuários da sua biblioteca não precisam ter o seu gerenciador de temas para o seu funcionar, mas se desejarem usar os dois, precisam usar o gerente de temas com seus patches aplicados. Deveria haver pouca objeção a isso, pois eles já têm a versão base, não é como se eles instalassem uma biblioteca totalmente nova. Eles estariam apenas aplicando um patch e recompilando.

Outras dicas

Em vez de subclassem a janela de tapplication, talvez você possa usar alocada () para receber as mesmas transmissões separadamente, pois é uma janela de nível superior.

Eu acho que faria o seguinte:

  • Coloque uma referência aos serviços de temas na seção de inicialização do temesrv.pas.
  • Coloque uma referência ao DWMServices na seção de inicialização do dwmsrv.pas (acho que o nome da sua unidade).

Como as unidades são finalizadas em ordem inversa a partir da ordem de inicialização, seu problema será resolvido.

Por que você não usa os ApplicationEvents e acaba com isso. Não há necessidade de mexer com a subclasse. A outra maneira é criar apenas uma subclasse e criar eventos multi-notificar e assinar quantos desejar.

Felicidades

Licenciado em: CC-BY-SA com atribuição
Não afiliado a StackOverflow
scroll top