时间戳

首页 > 解决方案 > Delphi Firemonkey - 无法将 TTabItem 的子类添加到 TTabControl

delphi - Delphi Firemonkey - 无法将 TTabItem 的子类添加到 TTabControl

问题描述

我可以将 TTabItem 添加到 TTabControl，我可以将 TTabItem 的子类添加到 TabControl，但我不能将 TTabItem 的子类添加到 TabControl。

示例 Firemonkey 应用程序 - 带有 TTabControl 的表单：

type
   TTabItem_subclass = class (TTabItem);
   TTabItem_sub_subclass = class (TTabItem_subclass);

procedure TForm1.FormCreate(Sender: TObject);
 procedure add_tab (t: TTabItem);
   begin
     t.Text := t.ClassName;
     t.Parent := TabControl1
  end;
begin
  add_tab (TTabItem.create (TabControl1));   // <-- works
  add_tab (TTabItem_subclass.create (TabControl1));  // <-- works
  add_tab (TTabItem_sub_subclass.create (TabControl1));  // <-- fails
end;

当应用程序运行时 TTabItem_sub_subclass 不显示：

在此处输入图像描述

我在 XE5 和东京都试过这个，结果相同。我错过了什么？

标签： delphi

解决方案

简短的回答：我认为您没有遗漏任何东西。如果事实上，您的代码确实成功地将子分类项添加到 TabControl，它只是没有显示。我认为这个问题是由 FMX 代码派生用于绘制作为 TTabItem 的子类的类的样式的方式中的缺陷引起的。我对 FMX 的了解不足以确定问题的确切原因，但我已经确定了似乎是一种功能性解决方法。

请参阅下面的示例项目代码，它成功显示了 TabItem subClass 和 TabItem sub_subClass 选项卡。

代码按原样结构化的原因是为了Item在我试图跟踪绘制过程是如何发生的时候，可以轻松地在 TabItem 的 FResourceLink 字段（代码中的变量）上设置更改内存断点。

通过观察 TabItem.Paint 方法，很明显该选项卡只有在其 FResourceLink 不为零时才会绘制。您的原始代码（和我的）的问题是，当Paint在 TabItem_subClass 上调用时，它的 FResourceLink已被分配一个值，而对于 TabItem_sub_subClass 它没有。显然，FResourceLink 是它获取用于绘制 TabItem 的样式名称的地方，如果找不到，则不会绘制 TabItem。

恐怕因为我不是 FMX 方面的专家，我发现它的代码在最好的时候有点像迷宫，而它的样式实现更是如此。但令我震惊的是，如果我能确保为 TabItem GetParentClassStyleLookupName 方法返回一个有效的样式名称，那就足够了。这就是 TCustomItem_sub_subclass.GetParentClassStyleLookupName 覆盖的原因。我想 FMX 专家可能会将其视为敲碎核桃的一把大锤，但你去吧。

代码

  type
    TForm1 = class(TForm)
      TabControl1: TTabControl;
      StyleObject1: TStyleObject;  // ignore this
      procedure FormCreate(Sender: TObject);
    private
    public
       Item :  TTabItem;
    end;

  [...]

  implementation

  [...]

  type
     TCustomItem_subclass = class (TTabItem)
     public
       constructor Create(AOwner : TComponent); override;
     end;

     TCustomItem_sub_subclass = class (TCustomItem_subclass)
       public
       constructor Create(AOwner : TComponent); override;
       function GetParentClassStyleLookupName: string; override;
     end;

  procedure TForm1.FormCreate(Sender: TObject);

   procedure add_tab (t: TTabItem);
     begin
       t.Text := t.ClassName;
       t.Parent := TabControl1
    end;

   begin

  {$define UseSubSub}
  {$ifdef UseSubSub}
     Item := TCustomItem_sub_subclass.Create(TabControl1);
  {$else}
     Item := TCustomItem_subclass.Create(TabControl1);
  {$endif}

     Item.Text := Item.ClassName;
     Item.Parent := TabControl1;

     Caption := TabControl1.ActiveTab.Text;

     Item := TCustomItem_subclass.Create(TabControl1);

     Item.Text := Item.ClassName;
     Item.Parent := TabControl1;

  end;

  constructor TCustomItem_subclass.Create(AOwner: TComponent);
  begin
    inherited;
  end;

  constructor TCustomItem_sub_subclass.Create(AOwner: TComponent);
  begin
    inherited;
  end;

  function TCustomItem_sub_subclass.GetParentClassStyleLookupName: string;
  begin
    Result := 'tabitemstyle';
  end;

TStyledControl.GenerateStyleName(const AClassName: string): string顺便说一句，在执行此操作时，我注意到FMX.Controls.Pas中的函数中似乎有一个潜伏的错误 如果AClassName去掉前导的参数TCustom以双 TT 开头，如 中TCustomTabItem，代码错误地删除了选项卡项。我没有时间或精力来进一步探索，但这就是为什么我的 TabItem 子类在Tab它们的名称中省略了 。

推荐阅读