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

时间：2014-07-27 16:15:21

标签： delphi components firemonkey delphi-xe6

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

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

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

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

My empty Popup

它内部的黑色区域是我想放弃像TEdit和其他人一样的控件。

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

My Popup with TEdit

但是我期待这个：

My popup with TEdit in the right position

如果我更改了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的父级。

1 个答案:

答案 0 :(得分：8)

仔细查看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也排除了您的其他＆＃34;未存储＆＃34;控件。

如果没有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.
相关问题
最新问题