Comment créer un dialog comme un composant qui permet de déposer d’autres contrôles à l’intérieur?

C’est un composant Firemonkey, mais je pouvais voir que la plupart des composants de base sont les mêmes pour VCL et FMX.

J’utilise un TPopup comme ancêtre. C’est pratique pour moi, car il rest sur la forme / image et je peux le câbler avec LiveBindings en utilisant le même contexte / la structure du parent, cela est très pratique pour moi.

J’ai besoin qu’il se comporte exactement comme le TPopup, en tant que conteneur. Mais j’ai besoin que ça aille mieux et que j’ai des boutons spécifiques (j’ai créé des propriétés et des automatisations pour mon logiciel à l’intérieur)

Le problème est que je crée des contrôles internes, comme les TLayouts, les Tpanels et les Tbuttons, pour que cela ressemble à ceci: (vide)

Mon Popup Vide

Cette zone noire à l’intérieur est celle où je veux déposer des commandes comme TEdit et d’autres.

J’ai défini tous les contrôles internes créés sur Store = false, de sorte qu’il ne soit pas stocké sur le système de streaming. Faire cela quand je laisse tomber un TEdit par exemple, ce que j’obtiens est ceci (Tedit avec aligné = top j’ai besoin de ceci):

Mon Popup avec TEdit

Cependant, je m’attendais à ceci:

Ma popup avec TEdit dans la bonne position

Si je change le Store = true, je peux obtenir le bon effet, mais tous les contrôles internes sont exposés dans le panneau Structure et chaque fois que je sauvegarde le formulaire et que je le rouvre, tout est dupliqué. Les composants internes exposés ne sont pas un problème pour moi, mais la duplication est, si je ferme et ouvre le composant 10 fois, je vais avoir la structure interne entière répliquée 10 fois.

Je vais essayer de montrer du code lié à la conception du composant:

Déclaration de classe:

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

Définition des propriétés des contrôles internes:

 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; 

Chargé:

 procedure TNaharFMXPopup.Loaded; begin inherited; ApplyControlsProp; SetEvents; end; 

J’ai essayé ce qui suit avec la notification, essayant de faire le contrôle inséré un parent pour mon “clientarea” intenal

 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; 

Mais cela n’a rien changé.

J’ai déjà posé une question similaire, mais je n’étais pas au courant de beaucoup de choses sur la création d’un tel composant et la réponse que j’ai eue a été peu utile, il me manquait le parent de chaque composant interne.

Maintenant, j’essaie vraiment de montrer où est mon besoin: j’ai besoin de supprimer des contrôles sur ma boîte de dialog TPopup qui sera associée à ClientArea à l’intérieur.

Jetez un coup d’œil à TTabControl / TTabItem dans l’unité FMX.TabControl. Ceci est votre exemple parfait car il faut essentiellement résoudre le même problème.

La fonction suivante est ce que vous devez remplacer:

 procedure DoAddObject(const AObject: TFmxObject); override; 

Ceci est appelé lorsqu’un contrôle est ajouté à votre contrôle. Remplacez cette fonction pour que votre contrôle soit ajouté au contrôle FpnlClientArea à la place. Vous obtiendrez quelque chose de similaire à ceci:

 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; 

Assurez-vous que AObject.Equals exclut également vos autres contrôles “non stockés”.

Sans le remplacement DoAddObject, le FMC TabControl afficherait le même problème que votre composant actuel.


Le TPopup n’est pas destiné à accepter des contrôles. Donc, il faut encore quelques astuces. Voici une version modifiée de votre unité qui fonctionne pour moi. J’ai ajouté quelques commentaires:

 unit NaharFMXPopup; interface uses System.UITypes, System.Variants, System.SysUtils, System.Classes, FMX.Types, FMX.Controls, FMX.Layouts, FMX.StdCtrls; type [ComponentPlatformsAtsortingbute(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 ressortingctions: 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. 

Je pense que vous avez besoin d’un médiateur dans votre création de contrôle au moment du design, comme ceci: http://sourcemaking.com/design_patterns/mediator/delphi