如何创建一个类似组件的对话框，允许在其中放置其他控件？答案

【问题标题】：How to create a dialog like component that allows drop other controls inside it?如何创建一个类似组件的对话框，允许在其中放置其他控件？
【发布时间】：2014-09-18 21:49:39
【问题描述】：

它是一个 Firemonkey 组件，但是我可以看到 VCL 和 FMX 的大部分组件库是相同的，所以如果你知道如何在 VCL 中做到这一点，请分享你的知识，它最终可能是我的解决方案案例。

我使用 TPopup 作为祖先。这对我来说很方便，因为它保留在表单/框架上，我可以使用与父级相同的上下文/结构将它与 LiveBindings 连接，这对我来说非常方便。

我需要它的行为完全是 TPopup，作为一个容器。但我需要它看起来更好，并有我的特定按钮（我在其中为我的软件创建了一些属性和自动化）

问题是我创建了一些内部控件，例如 TLayouts、Tpanels 和 Tbuttons 以使其看起来像这样：（空）

其中的黑色区域是我想要放置 TEdit 等控件的位置。

我已将所有内部创建的控件设置为 Store = false，因此它不会存储在流系统上。例如，当我放下 TEdit 时，我得到的是这个（Tedit with aligned=top 我需要这个）：

但是我期待这个：

如果我更改 Store = true 我可以获得正确的效果，但是所有内部控件都显示在结构面板上，并且每次我保存表单并重新打开时，所有内容都会重复。暴露的内部组件对我来说不是问题，但复制是，如果我关闭和打开组件 10 次，我将得到整个内部结构复制 10 次。

我将尝试展示一些与组件设计相关的代码：

类声明：

  [ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidOSX32 or pidiOSSimulator or pidiOSDevice or pidAndroid)]
  TNaharFMXPopup = class(TPopup, INaharControlAdapter, INaharControl)
  private
  protected
    FpnlMain       : TPanel;
    FlytToolBar    : TLayout;
    FbtnClose      : TButton;
    FbtnSave       : TButton;
    FbtnEdit       : TButton;
    FpnlClientArea : TPanel;
    FlblTitle      : TLabel;
    procedure   Loaded; override;
    procedure   Notification(AComponent: TComponent; Operation: TOperation); override;

constructor Create:

    constructor TNaharFMXPopup.Create(AOwner: TComponent);
    begin
      inherited;

      FpnlMain         := TPanel.Create(Self);
      FlblTitle        := TLabel.Create(Self);
      FlytToolBar      := TLayout.Create(Self);
      FbtnEdit         := TButton.Create(Self);
      FpnlClientArea   := TPanel.Create(Self);
      FbtnClose         := TButton.Create(FlytToolBar);
      FbtnSave          := TButton.Create(FlytToolBar);

      Height         := 382;
      Placement      := TPlacement.Center;
      StyleLookup    := 'combopopupstyle';
      Width          := 300;

      ApplyControlsProp;

    end;

设置内部控件的属性：

procedure TNaharFMXPopup.ApplyControlsProp;
begin
  with FpnlMain do
  begin
    Parent         := Self;
    Align          := TAlignLayout.Client;
    StyleLookup    := 'grouppanel';
    TabOrder       := 0;
    Margins.Bottom := 10;
    Margins.Left   := 10;
    Margins.Right  := 10;
    Margins.Top    := 10;
    Stored         := false;
  end;
  with FlblTitle do
  begin
    Parent         := FpnlMain;
    Text           := 'Título';
    Align          := TAlignLayout.Top;
    Height         := 36;
    StyleLookup    := 'flyouttitlelabel';
    Stored         := false;
  end;
  with FpnlClientArea do
  begin
    Parent         := FpnlMain;
    Align          := TAlignLayout.Client;
    StyleLookup    := 'gridpanel';
    TabOrder       := 0;
    Margins.Bottom := 5;
    Margins.Left   := 5;
    Margins.Right  := 5;
    Margins.Top    := 5;
    Stored         := false;
  end;
  with FlytToolBar do
  begin
    Parent         := FpnlMain;
    Align          := TAlignLayout.Bottom;
    Height         := 50;
    Stored         := false;
  end;
  with FbtnClose do
  begin
    Parent         := FlytToolBar;
    Text           := 'Fecha';
    Align          := TAlignLayout.Left;
    Height         := 50;
    StyleLookup    := 'tilebutton';
    TabOrder       := 0;
    Width          := 70;
    ModalResult    := mrClose;
    Stored         := false;
  end;
  with FbtnEdit do
  begin
    Parent         := FlytToolBar;
    Text           := '';//'Edita';
    Align          := TAlignLayout.Left;
    Height         := 50;
    StyleLookup    := 'tilebutton';
    TabOrder       := 1;
    Width          := 70;
    ModalResult    := mrContinue;
    Stored         := false;
    Enabled        := false;
  end;
  with FbtnSave do
  begin
    Parent         := FlytToolBar;
    Text           := 'Salva';
    Align          := TAlignLayout.Left;
    Height         := 50;
    StyleLookup    := 'tilebutton';
    TabOrder       := 2;
    Width          := 70;
    ModalResult    := mrOk;
    Stored         := false;
  end;
end;

已加载：

procedure TNaharFMXPopup.Loaded;
begin
  inherited;

  ApplyControlsProp;
  SetEvents;
end;

我已经尝试了以下通知，试图使插入的控件成为我内部“客户区域”的父级

procedure TNaharFMXPopup.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opInsert) and (csDesigning in ComponentState) then
  begin
    if AComponent.Owner = self then
      if AComponent is TFmxObject then
      begin
        (AComponent as TFmxObject).Parent := FpnlClientArea;
      end;
  end;

end;

但这并没有改变。

我以前问过类似的问题，但我不知道创建这样一个组件的很多事情，我得到的答案几乎没有帮助，我错过了每个内部组件的父级。

现在我试图真正表明我的需求在哪里：我需要在我的 TPopup 对话框上放置控件，该对话框将是其中 ClientArea 的父级。

【问题讨论】：

致反对者：为什么？我付出了很大的努力来创建这个组件，研究并且不知道如何修复它。我已经在这个问题上表现得更好。请问有什么可以改进的？
Fwiw，我觉得 -1 有点奇怪，考虑到你显然已经付出了很多努力来把你的 q 放在一起。也许他们会做一个提醒和解释。
我没有经常使用 FireMonkey，但我确实注意到有些组件只是不喜欢你在它们上面放置其他组件。因此，新放置的组件不会成为您单击的组件的子组件，而是成为您单击的父组件的子组件。您可以通过在对象设计器中拖动/重新排列组件来纠正此问题。不幸的是，我不知道为什么会发生这种情况，所以我无法为您提供直接答案。
@SilverWarior 设计器行为已从 XE2 更改。如果在表单上选择了 TButton，您可以在第一个版本中添加 TLabel。我相信迷惑了很多人（比如我自己），然后改成一些只接受使用对象设计器的人。我相信没关系。我可以在这个自定义组件中放置组件，但我不知道如何让它们显示在正确的位置。
是的，我记得在 FireMonkey 的第一个版本中，任何组件都充当容器并且可以包含任何其他组件。但我提到的问题是在 Delphi XE3 上。到目前为止，即使我拥有它，我也没有在 Delphi XE6 上尝试过。主要原因是当前项目限制我使用 Delphi XE3，因为我使用的库之一与 Delphi XE6 不完全兼容。

标签： delphi components firemonkey delphi-xe6

【解决方案1】：

仔细查看单元 FMX.TabControl 中的 TTabControl / TTabItem。这是您的完美示例，因为它基本上需要解决相同的问题。

以下函数是你需要重写的：

procedure DoAddObject(const AObject: TFmxObject); override;

当控件被添加到您的控件时调用。重写此函数，以便将您的控件添加到 FpnlClientArea 控件。你会得到类似这样的东西：

procedure TNaharFMXPopup.DoAddObject(const AObject: TFmxObject);
// ...
begin
  if (FpnlClientArea <> nil) and not AObject.Equals(FpnlClientArea) and not AObject.Equals(ResourceLink) then
  begin
    FpnlClientArea.AddObject(AObject);
  end
  else
    inherited;
end;

确保AObject.Equals 也排除了您的其他“未存储”控件。

如果没有 DoAddObject 覆盖，FMX TabControl 将显示与您的组件当前存在的相同问题。

TPopup 不打算接受控件。所以这需要更多的技巧。这是适合我的单位的修改版本。我添加了一些 cmets：

unit NaharFMXPopup;

interface

uses
  System.UITypes,
  System.Variants,
  System.SysUtils, System.Classes, FMX.Types, FMX.Controls, FMX.Layouts, FMX.StdCtrls;

type
  [ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidOSX32 or pidiOSSimulator or pidiOSDevice or pidAndroid)]
  TNaharFMXPopup = class(TPopup)
  private
    procedure   ApplyControlsProp;
  protected
    FpnlMain       : TPanel;
    FlytToolBar    : TLayout;
    FbtnClose      : TButton;
    FbtnSave       : TButton;
    FbtnEdit       : TButton;
    FpnlClientArea : TContent; // change to TContent. 
    // For TPanel we'd have to call SetAcceptControls(False), 
    // but that is not easily possible because that is protected
    FlblTitle      : TLabel;
    procedure   Loaded; override;
    procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure   DoAddObject(const AObject: TFmxObject); override;
  public
    procedure   InternalOnClose(Sender: TObject);
    procedure   InternalOnSave(Sender: TObject);
    procedure   InternalOnEdit(Sender: TObject);
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure   SetEvents;
  published
  end;

implementation


{ TNaharFMXPopup }

constructor TNaharFMXPopup.Create(AOwner: TComponent);
begin
  inherited;

  FpnlMain         := TPanel.Create(Self);
  FlblTitle        := TLabel.Create(Self);
  FlytToolBar      := TLayout.Create(Self);
  FbtnEdit         := TButton.Create(Self);
  FpnlClientArea   := TContent.Create(Self); // change to TContent
  FbtnClose         := TButton.Create(FlytToolBar);
  FbtnSave          := TButton.Create(FlytToolBar);

  Height         := 382;
  Placement      := TPlacement.Center;
  StyleLookup    := 'combopopupstyle';
  Width          := 300;

  // A TPopup is not intended to accept controls
  // so we have to undo those restrictions:
  Visible := True;
  SetAcceptsControls(True);

  ApplyControlsProp;
end;

destructor TNaharFMXPopup.Destroy;
begin

  inherited;
end;

procedure TNaharFMXPopup.ApplyControlsProp;
begin
  with FpnlMain do
  begin
    Parent         := Self;
    Align          := TAlignLayout.Bottom;
    StyleLookup    := 'grouppanel';
    TabOrder       := 0;
    Height         := 50;
    Margins.Bottom := 10;
    Margins.Left   := 10;
    Margins.Right  := 10;
    Margins.Top    := 10;
    Stored         := false;
  end;
  with FpnlClientArea do
  begin
    Parent         := Self; // we have to change this to Self (it refuses working if the parent is FPnlMain)
    Align          := TAlignLayout.Client;
    Margins.Left   := 3;
    Margins.Right  := 3;
    Margins.Top    := 3;
    Margins.Bottom := 3;
    Stored         := false;
  end;
  with FlytToolBar do
  begin
    Parent         := FpnlMain;
    Align          := TAlignLayout.Bottom;
    Height         := 50;
    Stored         := false;
  end;
  with FbtnClose do
  begin
    Parent         := FlytToolBar;
    Text           := 'Close';
    Align          := TAlignLayout.Left;
    Height         := 50;
    StyleLookup    := 'tilebutton';
    TabOrder       := 0;
    Width          := 70;
    ModalResult    := mrClose;
    Stored         := false;
  end;
  with FbtnEdit do
  begin
    Parent         := FlytToolBar;
    Text           := '';//'Edita';
    Align          := TAlignLayout.Left;
    Height         := 50;
    StyleLookup    := 'tilebutton';
    TabOrder       := 1;
    Width          := 70;
    ModalResult    := mrContinue;
    Stored         := false;
    Enabled        := false;
  end;
  with FbtnSave do
  begin
    Parent         := FlytToolBar;
    Text           := 'Save';
    Align          := TAlignLayout.Left;
    Height         := 50;
    StyleLookup    := 'tilebutton';
    TabOrder       := 2;
    Width          := 70;
    ModalResult    := mrOk;
    Stored         := false;
  end;
end;

procedure TNaharFMXPopup.Loaded;
begin
  inherited;

  ApplyControlsProp;
//  SetEvents;

end;

procedure TNaharFMXPopup.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;

end;

procedure TNaharFMXPopup.InternalOnClose(Sender: TObject);
begin
end;

procedure TNaharFMXPopup.InternalOnEdit(Sender: TObject);
begin
end;

procedure TNaharFMXPopup.InternalOnSave(Sender: TObject);
begin
end;

procedure TNaharFMXPopup.SetEvents;
begin
  FbtnClose.OnClick := InternalOnClose;
  FbtnSave.OnClick := InternalOnSave;
  FbtnEdit.OnClick := InternalOnEdit;
end;


procedure TNaharFMXPopup.DoAddObject(const AObject: TFmxObject);
begin
//inherited; try commenting the block bellow and uncommenting this one
//Exit;

  if (FpnlClientArea <> nil)
    and not AObject.Equals(FpnlClientArea)
    and not AObject.Equals(ResourceLink)
    and not AObject.Equals(FpnlMain)
    and not AObject.Equals(FlblTitle)
    and not AObject.Equals(FlytToolBar)
    and not AObject.Equals(FbtnEdit)
    and not AObject.Equals(FpnlClientArea)
    and not AObject.Equals(FbtnClose)
    and not AObject.Equals(FbtnSave) then

  begin
    FpnlClientArea.AddObject(AObject);
  end
  else
    inherited;
end;

end.

【讨论】：

我觉得有道理，我做了这个测试，添加了所有的 AObject,Equals 以排除内部创建的控件。但是它不起作用。例如当添加一个TRectangle时，它不会变成My Component的后代，如果我将它拖放到Structure Panel上放到这个组件上，它似乎被添加为父级，但它并没有改变它的根并消失从表格。有什么想法吗？
您能否发布一个指向完全可编译源的链接，以便我可以在这里试用？
这里是：link 这是一个精简的版本，我删除了与我的框架相关的部分，只保留了我们试图在这里解决的控制部分！谢谢！
@SebastianZ 如果您有更大的源样本（例如来自 Eduardo 的？），您可以将它包含在答案中吗？答案有多大并不重要，只要它包含好的信息 - 一个完整的例子将是一个很好的答案！
@DavidM 我已经添加了演示单元的修改版本。