VCL Styles 随机中断

Question

我有一个源自 TMemo 的控件。在我第一次使用 Delphi XE7 VCL Styles 之前，它一直很好用。在 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;