How to create a dialog like component that allows drop other controls inside it?

Question

It is a Firemonkey component, however I could see that most of the component base is the same for VCL and FMX, so please if you know how to do that in VCL share your knowledge, it can be eventually the solution for my case.

I am using a TPopup as the ancestor. It is convenient for me since it remains on the form/frame and I can wire it with LiveBindings using the same context/structure of the parent, this is very convenient for me.

I need it behave exactly it is the TPopup, as a container. But I need it looks better and have my specific buttons (I have created some properties and automations for my software inside it)

The problem is that I create some internal controls, like TLayouts, Tpanels and Tbuttons to make looks like this: (empty)

That black area inside it is where I want to drop controls like TEdit and others.

I have set all the internal created controls to Store = false, so it is not getting stored on the streaming system. Doing that when I drop a TEdit for example, what I get is this (Tedit with aligned=top I need this):

However I was expecting this:

If I change the Store = true I can get the right effect, but all the inside controls are exposed on the Structure panel and every time I save the form and reopen everything gets duplicated. The inside components exposed is not a problem for me, but the duplication is, if I close and open the component 10 times I will get the entire inside structure replicated 10 time.

I will try to show some code that is related to the design of the component:

Class declaration:

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

Setting properties of the internal controls:

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; 

Loaded:

procedure TNaharFMXPopup.Loaded; begin   inherited;    ApplyControlsProp;   SetEvents; end; 

I have tried the following with notification, trying to make the inserted control a parent for my intenal "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; 

But that made nothing change.

I have asked similar question before, but I was not aware of many things on creating such a component and the answer I got gave little help, I was missing the Parent of each internal component.

Now I am trying to really show where is my need: I need to drop controls on my TPopup dialog that will be parented of the ClientArea inside it.

Answer 1

Take a closer look at TTabControl / TTabItem in the unit FMX.TabControl. This is your perfect example because it basically needs to solve the same problem.

The following function is what you need to override:

procedure DoAddObject(const AObject: TFmxObject); override; 

This is called when a control is added to your control. Override this function so that your control is added to the FpnlClientArea control instead. You'd get something similar to this:

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; 

Make sure that AObject.Equals also excludes your other "not stored" controls.

Without the DoAddObject override, the FMX TabControl would show the same problem as your component currently has.

---

The TPopup is not intended to accept controls. So that needs a few more tricks. Here's a modified version of your unit that works for me. I've added a few comments:

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.