如何创build一个对话框，允许在其中放置其他控件？

这是一个Firemonkey组件，但是我可以看到，大部分的组件基础对于VCL和FMX都是一样的，所以如果你知道在VCL中如何做到这一点，请分享你的知识，最终可以成为我的案例的解决scheme。

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

我需要它的行为正是TPopup，作为一个容器。 但我需要它看起来更好，并有我的具体button（我已经创build了一些属性和自动化为我的软件在里面）

问题是我创build了一些内部控件，比如TLayouts，Tpanels和Tbuttons，看起来像这样：（空）

里面的黑色区域是我想放置像TEdit和其他控件的地方。

我已经将所有内部创build的控件设置为Store = false，所以它不会被存储在stream式系统上。 这样做，当我删除一个TEdit例如，我得到的是（Tedit与align =顶部我需要这个）：

但是我期待这样的：

如果我改变了Store = true，我可以得到正确的效果，但是所有的内部控件都暴露在Structure面板上，每次保存表单并重新打开所有的东西都会被重复。 内部组件暴露对我来说不是问题，但是重复的是，如果我closures并打开组件10次，我会得到整个内部结构复制10次。

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

类声明：

[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; 

我已经尝试了以下通知，试图使插入的控件为我的内部“clientarea”

 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; 

但这没有任何改变。

我曾经问过类似的问题，但是我并没有意识到创build这样一个组件的许多事情，而且我得到的答案也没有什么帮助，我错过了每个内部组件的Parent。

现在我试图真正地显示我的需求：我需要删除控制在我的TPopup对话框，它将在其中的ClientArea Parented。

Answer 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不打算接受控制。 所以这需要更多的技巧。 这是你的单位的修改版本适合我。 我已经添加了一些评论：

 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. 

Answer 2

我觉得你需要调解器在你的控制创builddevise时间是这样的： http : //sourcemaking.com/design_patterns/mediator/delphi