如何创建一个类似对话框的对话框,允许删除其中的其他控件？

Question

它是一个Firemonkey组件,但是我可以看到VCL和FMX的大部分组件基础是相同的,所以如果你知道如何在VCL中分享你的知识,那么它最终可能是我案例的解决方案.

我使用TPopup作为祖先.它对我来说很方便,因为它保留在表单/框架上,我可以使用父进程的相同上下文/结构与LiveBindings连接,这对我来说非常方便.

我需要它的行为恰好是TPopup,作为一个容器.但我需要它看起来更好,并有我的特定按钮(我已经为我的软件内部创建了一些属性和自动化)

问题是我创建了一些内部控件,比如TLayouts,Tpanels和Tbuttons,看起来像这样:(空)

其中的黑色区域是我想放弃像TEdit和其他人一样的控件.

我已将所有内部创建的控件设置为Store = false,因此它不会存储在流式系统上.当我放弃一个TEdit时这样做,我得到的是这个(Tedit with aligned = top我需要这个):

但是我期待这个:

如果我更改Store = true,我可以获得正确的效果,但所有内部控件都在Structure面板上公开,每次保存表单并重新打开时,所有内容都会重复.暴露的内部组件对我来说不是问题,但重复的是,如果我关闭并打开组件10次,我会将整个内部结构复制10次.

我将尝试显示一些与组件设计相关的代码:

舱位声明:

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

但这没有任何改变.

我以前曾问过类似的问题,但是我没有意识到创建这样一个组件的很多事情,而我得到的答案几乎没有帮助,我错过了每个内部组件的Parent.

现在我试图真正展示我的需求:我需要放弃我的TPopup对话框中的控件,该对话框将成为其中ClientArea的父级.

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.