Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

VCL Styles breaks randomly

I have a control derived from TMemo. It worked nice until I used for the first time with Delphi XE7 VCL Styles. Under Delphi XE7, styles are not applied to the scroll bars of the control. If dark theme/style is used, it looks horrible, while the scroll bars are silver.

bug

Trying to create a minimum project for which we can reproduce the bug I have discovered something really interesting: Adding/deleting random lines of code (or DFM controls), will make the bug appear/disappear.

Question: What REALLY causes this weird behavior and how to fix it?

Source code here:

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

like image 796
Server Overflow Avatar asked Feb 11 '15 20:02

Server Overflow


1 Answers

Registering StyleHook for custom class solves issue:

  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;

There is bug in TStyleEngine.HandleMessage function, specifically in part that tries to find appropriate StyleHook class to handle messages

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;

If StyleHook is registered for exact class then there is no problem, and appropriate StyleHook class will be returned. However, "the hard way" part is flawed. It will try to find class ancestor that has registered StyleHook. But it will return first ancestor it comes across. If it finds TEditStyleHook first (that is registered for TCustomEdit class), it will use that one instead of TMemoStyleHook. Since TEditStyleHook does not know how to handle scrollbars issue appears.

Randomness in buggy behavior is due the way RegisteredStyleHooks are stored. They are stored in dictionary where key is TClass. And order is determined by TClass hash that is basically pointer to class info and can change as you change code.

Issue is reported as RSP-10066 and there is attached project that reproduces it.

With help of following code it is easy to see how order of registered classes changes as you add/remove code and/or other controls.

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;
like image 122
Dalija Prasnikar Avatar answered Nov 02 '22 13:11

Dalija Prasnikar