¿Cómo crear un diálogo como componente que permite soltar otros controles dentro de él?
Es un componente Firemonkey, sin embargo, pude ver que la mayor parte de la base de componentes es la misma para VCL y FMX, así que por favor si sabes cómo hacerlo en VCL comparte tu conocimiento, puede ser eventualmente la solución para mi caso.
Estoy usando un TPopup como antepasado. Es conveniente para mí, ya que permanece en el formulario/marco y puedo conectarlo con LiveBindings utilizando el mismo contexto/estructura del padre, esto es muy conveniente para mí.
Necesito que se comporte exactamente lo que es el TPopup, como un contenedor. Pero necesito que se vea mejor y tenga mis botones específicos (he creado algunas propiedades y automatizaciones para mi software dentro de él)
El problema es que creo algunos controles internos, como TLayouts, Tpanels y Tbuttons para hacer que se vea así: (empty)
Esa zona negra dentro es donde quiero soltar controles como TEdit y otros.
He establecido todos los controles internos creados a Store = false, por lo que no está obteniendo almacenado en el sistema de streaming. Haciendo eso cuando dejo caer un TEdit por ejemplo, lo que obtengo es esto (Tedit con aligned=top Necesito esto):
Sin embargo yo esperaba esto:
Si cambio el Store = true puedo obtener el efecto correcto, pero todos los controles internos están expuestos en el panel de Estructura y cada vez que guardo el formulario y reabro todo se duplica. Los componentes internos expuestos no es un problema para mí, pero la duplicación es, si cierre y abra el componente 10 veces obtendré toda la estructura interior replicada 10 veces.
Intentaré mostrar algún código relacionado con el diseño del componente:
Declaración de clase:
[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;
Propiedades de configuración de los controles internos:
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;
Cargado:
procedure TNaharFMXPopup.Loaded;
begin
inherited;
ApplyControlsProp;
SetEvents;
end;
He intentado lo siguiente con notificación, tratando de hacer que el control insertado sea un padre para mi "clientarea"interna
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;
Pero eso no hizo nada cambio.
He hecho una pregunta similar antes, pero no era consciente de muchas cosas sobre la creación de un componente de este tipo y la respuesta que recibí dio poca ayuda, me faltaba el Padre de cada componente interno.
Ahora estoy tratando de mostrar realmente dónde está mi necesidad: necesito soltar controles en mi diálogo de TPopup que serán parentados de la área de cliente dentro de él.
2 answers
Eche un vistazo más de cerca a TTabControl / TTabItem en la unidad FMX.TabControl. Este es tu ejemplo perfecto porque básicamente necesita resolver el mismo problema.
La siguiente función es lo que necesita sobreescribir:
procedure DoAddObject(const AObject: TFmxObject); override;
Esto se llama cuando se agrega un control a su control. Sobreescriba esta función para que su control se agregue al control FpnlClientArea en su lugar. Obtendrías algo similar a esto:
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;
Asegúrese de que AObject.Equals también excluye su otro "no "controles almacenados".
Sin la anulación de DoAddObject, el FMX TabControl mostraría el mismo problema que su componente tiene actualmente.
El TPopup no está destinado a aceptar controles. Así que eso necesita algunos trucos más. Aquí hay una versión modificada de su unidad que funciona para mí. He añadido algunos comentarios:
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.
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/ajaxhispano.com/template/agent.layouts/content.php on line 61
2015-01-21 22:09:15
Creo que necesita mediador en su creación de control en tiempo de diseño como este: http://sourcemaking.com/design_patterns/mediator/delphi
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/ajaxhispano.com/template/agent.layouts/content.php on line 61
2014-10-15 08:04:29