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.

Etheridge

To the downvoter: why that? I have made big effort to create this component, research and dont know what to do fix it. I have exposed better I could on this question. Please what can I improve? – Etheridge

Fwiw, I thought the -1 was a bit strange, considering you obviously have gone to a good deal of effort to put to your q together. Perhaps they will do a heads-up and explain. – Decision

I haven't used FireMonkey a lot but I did noticed that some components just don't like you placing other components on them. So instead of the newly placed component to become child component of the one you have clicked one it becomes child component of parent component of the one you clicked on. You can correct this by draging/rearangig components in object designer. Unfortunately I have no idea why this is happening so I can't provide you with direct answer. – Driest

@Driest The designer behavior was changed from XE2. The first version you could add a TLabel inside a TButton if that was selected on the form. I believe that confused many (like myself) and then changed to some only accept that using the object designer. I believe that is ok. I could place components inside this custom component, but I dont know how to make them show in the right place. – Etheridge

Yes I remember that in first version of FireMonkey that any component acted as container and could contain any other component. But the problems I mentioned were on Delphi XE3. So far I haven't try this on Delphi XE6 even thou I own it. The main reason for this is that current project limits me to Delphi XE3 due to one of the libraryies I use not being fully compatible with Delphi XE6. – Driest

This can be done with ease just not at design time and not in the way you want it. Also I wouldn't use Tpopup as a base because it has some nasty bugs when it comes to editable components like TEdit or TMemo. – Celestine

@PeterV. I am using TPopup this way because I can wire the TEdit (and others) with the same LiveBindings of the form. Very handy. In XE6 there is no major bugs with editable components. In XE5 was almost impossible to use it. I have made many TPopup with complex editing and it is working for me. In a separated dialog I will need to prepare all the LiveBinding context for that dialog. Do you know how to make what I asked? – Etheridge

Do You create the controls in the stylefile of your component? – Rhondarhondda

Are you using XE7, and the new master view / specialised device views? – Oboe

@DavidM no, I am using XE6 now, I made this question when using XE5, however I believe there is nothing related to the new view. I am not going to use that anyways, since I use the regular FMX controls for my own presenting style. – Etheridge

are you still havin this problem? – Operant

@caputo Yes. I am actually doing this in a total different manner, since I could not solve it. Not as a dialog/component but as a TPopup directly on the form, so I copy and past everything inside it. – Etheridge

@eelias can you provide the source of a mcve I will like to try, maybe I can help on it – Operant

@eelias I added a small (100) bounty. 31 upvotes, one answer with 0 votes... someone must know or be able to find what's going on. (It's a good and very interesting question, by the way.) – Oboe

@DavidM Hey, thank you. I am still have this an open issue for me. I am this based on copy and past of the TPopup in everyplace I need and then adding the controls inside. But it has to have a way to create this. Thanks! – Etheridge

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.

Fiction

I see it makes sense, I have made this test, added all the AObject,Equals to exclude the internal created controls. However it does not work. When adding a TRectangle for example, it does not turn as descendant of the My Component, if I drag and drop it on Structure Panel to drop on this component, it seems to be added as parent, but it does not change its root and disappear from the form. Any idea? – Etheridge

Can you post a link to a fully compilable source so that I can try it here? – Fiction

Here is: link this is a stripped down version where I removed the part related to my framework keeping only the control part we are trying to solve here! Thanks! – Etheridge

@SebastianZ If you have a bigger source sample (eg from Eduardo's?) can you include it in the answer please? It doesn't matter how big an answer is, if it includes good info - and a complete example would be a great answer! – Oboe

@DavidM I've added a modified version of the demo unit. – Fiction

@SebastianZ Great, it worked ! I would suggest to add FpnlClientArea.ClipChildren := true; on ApplyControlsProp procedure, it will force the child controls to keep inside the client area. Thanks ! – Etheridge

@SebastianZ Thanks very much! That addition is well worth a bounty (probably more of a bounty than I put on the question.) I'm about to award it, just want to note it's a great answer and thanks for adding the extra code. – Oboe