How to create a dialog box similar to a component that allows you to insert other controls into it?

Question

This 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 this in VCL, share your knowledge, this may be the final solution for my case.

I use TPopup as an ancestor. This is convenient for me, since it remains on the form / frame, and I can connect it using LiveBindings, using the same context / parent structure, which is very convenient for me.

I need it to behave exactly, it's TPopup, like a container. But I need it to look better, and I had certain buttons (I created some properties and features for my software inside it)

The problem is that I create some internal controls, such as TLayouts, Tpanels and Tbuttons, so that they look like this: (empty)

In this black area inside, I want to reset controls such as TEdit and others.

I set all internal created controls to Store = false, so it is not saved on the streaming system. If I do this when I throw TEdit, for example, I get this (Tedit with aligned = top I need it):

However, I expected this:

If I change Store = true, I can get the correct effect, but all the internal controls are displayed in the "Structure" panel, and every time I save the form and reopen it, everything is duplicated. Exposed internal components are not a problem for me, but the duplication is that if I close and open the component 10 times, I get the whole internal structure replicated 10 times.

I will try to show the code associated with the component construction:

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 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 tried the following with a notification, trying to make the inserted control 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 didn’t change anything.

I asked a similar question before, but I did not know about many things when creating such a component, and the answer I received did not help much, I lacked the parent of each internal component.

Now I'm trying to show where my need is: I need to disable the controls in my TPopup dialog, which will be based on ClientArea inside it.

Answer 1

Check out TTabControl / TTabItem in the FMX.TabControl block. This is your ideal 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 the control is added to your control. Override this function so that the control is added to the FpnlClientArea control instead. You will 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 AObject.Equals also excludes your other " AObject.Equals " controls.

Without overriding DoAddObject, the FMX TabControl will show the same problem as your component.

---

TPopup is not designed to accept controls. This requires a few more tricks. Here's a modified version of your unit that works for me. I 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. 

Answer 2

I think you need a pick in creating your control during development as follows: http://sourcemaking.com/design_patterns/mediator/delphi