VCL样式随机打破

Question

我有一个源自TMemo的控件.在我第一次使用Delphi XE7 VCL样式之前,它工作得很好.在Delphi XE7下,样式不会应用于控件的滚动条.如果使用黑暗的主题/风格,它看起来很可怕,而滚动条是银色的.

尝试创建一个我们可以重现错误的最小项目我发现了一些非常有趣的东西:添加/删除随机代码行(或DFM控件)会使错误出现/消失.

问题:什么真正导致这种奇怪的行为以及如何解决它？

源代码在这里:

http://s000.tinyupload.com/index.php?file_id=24129853712119260018

Answer 1

注册StyleHook自定义类解决问题:

  TMyMemo = class(TMemo)
  strict private
    class constructor Create;
    class destructor Destroy;
  end;

class constructor TMyMemo.Create;
begin
  TCustomStyleEngine.RegisterStyleHook(TMyMemo, TMemoStyleHook);
end;

class destructor TMyMemo.Destroy;
begin
  TCustomStyleEngine.UnRegisterStyleHook(TMyMemo, TMemoStyleHook);
end;

TStyleEngine.HandleMessage函数中存在错误,特别是试图找到适当的StyleHook类来处理消息

if RegisteredStyleHooks.ContainsKey(Control.ClassType) then
  // The easy way: The class is registered
  LStyleHook := CreateStyleHook(RegisteredStyleHooks[Control.ClassType])
else
begin
  // The hard way: An ancestor is registered
  for LItem in RegisteredStyleHooks do
    if Control.InheritsFrom(LItem.Key) then
    begin
      LStyleHook := CreateStyleHook(Litem.Value);
      Break;
    end;

如果StyleHook注册了确切的类,那么没有问题,StyleHook将返回适当的类.然而,"艰难的方式"部分是有缺陷的.它将尝试找到已注册的类祖先StyleHook.但它会回归它所遇到的第一个祖先.如果它TEditStyleHook首先找到(为TCustomEdit类注册),它将使用那个而不是TMemoStyleHook.由于TEditStyleHook不知道如何处理滚动条问题出现.

有缺陷行为的随机性是由于RegisteredStyleHooks存储的方式.它们存储在密钥所在的字典中TClass.并且顺序由TClass散列决定,散列基本上是指向类信息的指针,并且可以在更改代码时更改.

问题报告为RSP-10066,并附有重现它的项目.

借助以下代码,您可以轻松查看注册类的顺序在添加/删除代码和/或其他控件时的变化情况.

type
  TStyleHelper = class(TCustomStyleEngine)
  public
    class function GetClasses: TArray<TClass>;
  end;

class function TStyleHelper.GetClasses: TArray<TClass>;
begin
  Result := Self.RegisteredStyleHooks.Keys.ToArray;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  LItem: TClass;
  Classes: TArray<TClass>;
begin
  Classes := TStyleHelper.GetClasses;
  for LItem in Classes do
    MyMemo1.Lines.Add(LItem.ClassName);
end;