VCL 样式随机中断

VCL Styles breaks randomly

我有一个从 TMemo 派生的控件。在我第一次使用 Delphi XE7 VCL Styles 之前,它一直很好用。在 Delphi XE7 下,样式不会应用于控件的滚动条。如果使用深色theme/style,看起来很可怕,而滚动条是银色的。

尝试创建一个我们可以重现错误的最小项目我发现了一些非常有趣的东西:Adding/deleting 随机代码行(或 DFM 控件)将产生错误 appear/disappear。

问题:究竟是什么导致了这种奇怪的行为以及如何解决它?

源代码在这里:

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

为自定义 class 注册 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 class 来处理消息的部分

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 被准确注册为 class 那么就没有问题,适当的 StyleHook class 将被 return 编辑。但是,"the hard way" 部分存在缺陷。它将尝试找到已注册 StyleHook 的 class 祖先。但是它会return它遇到的第一个祖先。如果它首先找到 TEditStyleHook(为 TCustomEdit class 注册),它将使用那个而不是 TMemoStyleHook。由于 TEditStyleHook 不知道如何处理滚动条问题出现。

越野车行为的随机性是由于 RegisteredStyleHooks 的存储方式。它们存储在关键字为 TClass 的字典中。顺序由 TClass 散列决定,它基本上是指向 class 信息的指针,并且可以随着您更改代码而改变。

问题被报告为 RSP-10066 并且有一个重现它的附加项目。

在以下代码的帮助下,很容易看出注册的 classes 的顺序如何随着您 add/remove 代码 and/or 其他控件的变化而变化。

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;