Search code examples
delphicomponentsfiremonkeydelphi-xe6

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

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)

My empty Popup

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):

My Popup with TEdit

However I was expecting this:

My popup with TEdit in the right position

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.

Solution

  • 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.