Discussion :

[nicolas.bbs]

Bonjour,

Je suis rôdé au développement de composants non visuels et d'éditeurs de composants pour des cas courants.
Désormais j'ai besoin de créer un composant qui contient des sous-composants, qui ne sont pas tous du même type (ce qui exclut l'utilisation de TOwnedCollection).
Ce dont j'ai besoin est très similaire à TActionList avec les différents types dérivés de TAction.
J'ai donc pris modèle sur TContainedAction et TContainedActionList, avec une nuance : dans mon cas j'ai une liste arborescente (chaque sous-composant peut donc contenir d'autres sous-composants).
Chaque objet pouvant être à la fois conteneur et contenu, j'ai donc utilisé le même type de base pour le conteneur et le contenu, en "fusionnant" le code de TContainedAction et TContainedActionList.

Le code de mon composant (la partie qui concerne cette structure) se trouve au bas du message.

Avec ce code, les sous-composants sont correctement enregistrés dans le dfm, et correctement relus.
Mais après rechargement, ils apparaissent sur la fiche ! Tous empilés en haut à gauche tant que je ne les bouge pas, puis ils s'enregistrent avec leur position si je les bouge. Mon objectif était, comme pour le TActionList, qu'ils n'apparaissent pas directement sur la fiche mais seulement dans mon éditeur de composant et dans la vue structure de la fiche.
Autre différence notable : avec le TActionList, à chaque objet action correspond une déclaration de champ dans la classe de la fiche, qui donne un accès direct à l'action. Moi je ne l'ai pas, mais ce point là m'arrange (je n'ai pas besoin d'encombrer le code avec ces déclarations).
Enfin, j'ai été obligé de modifier légèrement la procédure getChildren, sans quoi les sous-composants ne sont pas enregistrés dans le dfm après un premier rechargement :
En effet : même si je prends la précaution de mettre le composant parent comme propriétaire de ses enfants avec mon éditeur dans l'EDI, le owner n'est pas indiqué dans le dfm, et après rechargement c'est systématiquement la fiche qui devient le owner de tous les sous-composants. J'obtiens pourtant bien la structure suivante dans le dfm (les types réels sont dérivés de TMVLogicNode) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 object MVLogicView1: TMVLogicView
    Left = 529
    Top = 144
    object TMVDataLogicItem
      nodeExpanded = False
      object TMVDataLogicItem
        nodeExpanded = False
      end
    end
  end

Je pensais que le fait que les objets soient imbriqués dans le dfm aurait une influence sur le owner imposé à la relecture, mais visiblement non.

Avec ce code qui me semble similaire à celui de TContainedAction et TContainedActionList, j'obtiens donc un comportement légèrement différent.
Je me demande si ces aspects ne seraient pas à régler dans le code de l'éditeur du composant (l'EDI n'interroge-t-il pas l'éditeur du composant pour savoir qui doit être le owner au moment du chargement ?), mais je ne trouve pas le code source de l'éditeur de TActionList pour avoir un exemple.

Quelqu'un saurait-il m'expliquer les subtilités ? Le plus important pour moi serait de ne pas polluer le visuel de la fiche avec les sous-composants.
Merci d'avance pour vos réponses.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
 
  TMVLogicNode = class(TComponent)
  private
    FContainer: TMVLogicNode;
    FItems:TList<TMVLogicNode>;
    //Fonctions de l'objet vu comme enfant
    procedure SetContainer(AContainer: TMVLogicNode);
    function GetIndex: Integer;
    procedure SetIndex(Value: Integer);
 
    //Fonctions de l'objet vu comme parent
    function GetLogicItem(Index: Integer): TMVLogicNode;
//    procedure SetLogicItem(Index: Integer; Value: TMVLogicNode);
    function GetLogicItemCount: Integer;
  protected
    procedure ReadState(Reader: TReader); override;
    procedure AddLogicItem(const item: TMVLogicNode);
    procedure RemoveLogicItem(const item: TMVLogicNode);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetChildOrder(Component: TComponent; Order: Integer); override;
  public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
 
     //Fonctions et propriétés de l'objet vu comme parent
     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
     property LogicItems[Index: Integer]: TMVLogicNode read GetLogicItem {write SetLogicItem}; default;
     property LogicItemCount: Integer read GetLogicItemCount;
     function GetEnumerator:TList<TMVLogicNode>.TEnumerator;
 
     //Fonctions et propriétés de l'objet vu comme enfant
     function GetParentComponent: TComponent; override;
     function HasParent: Boolean; override;
     procedure SetParentComponent(AParent: TComponent); override;
     property Container: TMVLogicNode read FContainer write SetContainer;
     property Index: Integer read GetIndex write SetIndex stored False;
  end;
 
{ TMVLogicNode }
 
procedure TMVLogicNode.AddLogicItem(const item: TMVLogicNode);
begin
  if item = nil then
    raise Exception.CreateFMT(SParamIsNil, ['item']);
  FItems.Add(item);
  item.FContainer := Self;
  item.FreeNotification(Self);
end;
 
constructor TMVLogicNode.Create(AOwner: TComponent);
begin
  inherited;
  FItems:=TList<TMVLogicNode>.Create;
end;
 
destructor TMVLogicNode.Destroy;
begin
  if FItems <> nil then
    while FItems.Count > 0 do
{$IF not Defined(AUTOREFCOUNT)}
      FItems.Last.Free;
{$ELSE}
      FItems.Last.Container := nil;
{$ENDIF}
  FreeAndNil(FItems);
  inherited;
end;
 
procedure TMVLogicNode.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
  I: Integer;
  LogicItem: TMVLogicNode;
begin
  if @Proc = nil then
    raise Exception.CreateFMT(SParamIsNil, ['Proc']);
  for I := 0 to FItems.Count - 1 do
  begin
    LogicItem := FItems.List[I];
//    if LogicItem.Owner = Root then //modif par rapport à TContainedActionList, car en pratique après rechargement le owner est la fiche et le root est le premier TMVLogicNode
      Proc(LogicItem);
  end;
end;
 
function TMVLogicNode.GetEnumerator:TList<TMVLogicNode>.TEnumerator;
begin
   result:=FItems.GetEnumerator;
end;
 
function TMVLogicNode.GetIndex: Integer;
begin
  if (FContainer <> nil) and (FContainer.FItems <> nil) then
    Result := FContainer.FItems.IndexOf(Self)
  else
    Result := -1;
end;
 
function TMVLogicNode.GetLogicItem(Index: Integer): TMVLogicNode;
begin
  Result := FItems[Index];
end;
 
function TMVLogicNode.GetLogicItemCount: Integer;
begin
  if FItems <> nil then
    Result := FItems.Count
  else
    Result := 0;
end;
 
function TMVLogicNode.GetParentComponent: TComponent;
begin
  if FContainer <> nil then
    Result := FContainer
  else
    Result := inherited GetParentComponent;
end;
 
function TMVLogicNode.HasParent: Boolean;
begin
  if FContainer <> nil then
    Result := True
  else
    Result := inherited HasParent;
end;
 
procedure TMVLogicNode.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if (AComponent is TMVLogicNode) then
      RemoveLogicItem(TMVLogicNode(AComponent));
  end;
end;
 
procedure TMVLogicNode.ReadState(Reader: TReader);
begin
  inherited ReadState(Reader);
  if Reader.Parent is TMVLogicNode then
    Container := TMVLogicNode(Reader.Parent);
end;
 
procedure TMVLogicNode.RemoveLogicItem(const item: TMVLogicNode);
begin
  if (FItems <> nil) and (FItems.Remove(item) >= 0) then
  begin
    item.RemoveFreeNotification(Self);
    item.FContainer := nil;
  end;
end;
 
procedure TMVLogicNode.SetChildOrder(Component: TComponent; Order: Integer);
begin
  if (FItems <> nil) and (FItems.IndexOf(TMVLogicNode(Component)) >= 0) then
    (Component as TMVLogicNode).Index := Order;
end;
 
procedure TMVLogicNode.SetContainer(AContainer: TMVLogicNode);
begin
  if AContainer <> FContainer then
  begin
    if FContainer <> nil then
      FContainer.RemoveLogicItem(Self);
    if AContainer <> nil then
      AContainer.AddLogicItem(Self);
  end;
end;
 
procedure TMVLogicNode.SetIndex(Value: Integer);
var
  CurIndex, Count: Integer;
begin
  CurIndex := GetIndex;
  if CurIndex >= 0 then
  begin
    Count := FContainer.FItems.Count;
    if Value < 0 then
      Value := 0;
    if Value >= Count then
      Value := Count - 1;
    if Value <> CurIndex then
    begin
      FContainer.FItems.Delete(CurIndex);
      FContainer.FItems.Insert(Value, Self);
    end;
  end;
end;
 
{procedure TMVLogicNode.SetLogicItem(Index: Integer; Value: TMVLogicNode);
begin
  FItems[Index].Assign(Value);
end;}
 
procedure TMVLogicNode.SetParentComponent(AParent: TComponent);
begin
  if not(csLoading in ComponentState) and (AParent is TMVLogicNode) then
    Container := TMVLogicNode(AParent);
end;

[Paul TOTH]

on passe un temps fou à rendre les composants gérables dans l'IDE

sur un project j'ai une série de descendants et j'utilise cette classe de base, la solution à ton problème doit être de cet ordre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
 
 
  // Custom component attached to Mailer in the IDE
  TMailerSubComponent = class(TComponent)
  private
    FParent  : TMailer;
  protected
    procedure ReadState(Reader: TReader); override;
  public
    destructor Destroy; override;
    function HasParent: Boolean; override;
    function GetParentComponent: TComponent; override;
  end;
 
{ TMailerSubComponent }
 
destructor TMailerSubComponent.Destroy;
begin
  SetParentComponent(nil);
  inherited;
end;
 
procedure TMailerSubComponent.ReadState(Reader: TReader);
begin
  inherited;
  if Reader.Parent is TMailer then
    FParent := TMailer(Reader.Parent);
end;
 
function TMailerSubComponent.HasParent: Boolean;
begin
  Result := True;
end;
 
function TMailerSubComponent.GetParentComponent: TComponent;
begin
  Result := FParent;
end;

[nicolas.bbs]

Bonjour Paul,

Je n'ai rien vu de particulier dans ta solution, et pour m'assurer que c'était équivalent à la mienne j'ai simplement ajouté ton code dans mon package, en changeant simplement le type du parent par mon propre parent.
Et j'obtiens exactement le même résultat : les objets TMailerSubComponent apparaissent en haut à gauche de la fiche quand je la recharge (j'ai écrit le dfm manuellement pour ne pas avoir à modifier l'éditeur de composant).

Je suis sous Delphi 10.1 Berlin, mais je pense que cela n'a pas d'importance.
Si dans ton cas les sous-composants n'apparaissent pas sur la fiche, est-ce que tu peux me montrer 2 choses ?
- le contenu du dfm obtenu ?
- le code de gestion des sous-composants dans ton composant parent TMailer ?

Merci d'avance.

[Paul TOTH]

je surcharge cela

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
 protected
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;

pour chaque composant enfant je test si Owner <> Self et dans ce cas j'appelle Proc

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
procedure TMailer.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
  Index     : Integer;
begin
  for Index := 0 to FItems.Count - 1 do
  begin
    if FItems[Index].Owner <> Self then
      Proc(FItems[Index]);
  end;

ah et j'ai ça aussi au niveau des sous composants

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
 
procedure Txxx.SetParentComponent(AParent: TComponent);
begin
  if FParent <> nil then
    FParent.FItems.Remove(Self);
  FParent := AParent as TMailer;
  if FParent <> nil then
    FParent.FItems.Add(Self);
end;

[nicolas.bbs]

Bonjour Paul, merci pour ta participation.

J'ai les mêmes surcharges, avec quelques différences (voir mon premier message), donc voici quelques commentaires sur les différences :

- GetChildren et le test sur FItems[Index].Owner : d'après mes tests, getChildren permet de contrôler l'exécution (à travers proc) de l'écriture des sous-composants dans le dfm, dans la section du composant parent.
Après la construction des items par ton éditeur, le owner est celui donné par ton éditeur au constructeur. En revanche après relecture de la fiche, dans mon cas c'est toujours la fiche qui est le owner des items. Et le root reçu en paramètre par GetChildren est toujours la fiche. C'est cohérent avec le test if Action.Owner = Root then trouvé dans TContainedActionList.GetChildren, bien que ce test soit à mon avis inutile dans notre contexte.
Ton test FItems[Index].Owner <> Self donnera le même résultat, bien que je n'en saisisse pas non plus l'intérêt. Dans mon cas j'ai simplement retiré le test.

- setParentComponent : sert au moment de la relecture du dfm, indique dans quel parent le sous-composant était écrit. Permet donc de recréer la hiérarchie.
Mon code, identique à celui de TContainedAction, est un peu plus complexe que le tiens il passe par un setter et des procédures add/remove pour affecter le parent (Container) et il y a des notifications. Mais le résultat est le même.
Fait perturbant dans TContainedAction : le test if not(csLoading in ComponentState) dans setParentComponent. Je l'ai conservé dans mon premier post, puis j'ai essayé de le retirer, et cela ne change rien à mon problème.

Du coup je ne vois toujours pas comment tu fais pour que les sous-composants n'apparaissent pas sur la fiche au rechargement. La logique voudrait qu'ils n'apparaissent pas du moment que hasParent retourne true, mais ça ne semble pas être le cas.

[Paul TOTH]

alors dans mon cas c'est toujours la fiche le propriétaire

j'ai un éditeur de propriétés qui permet d'ajouter un élément, et l'élément ajouté est créé avec la fiche comme propriétaire.

mon composant c'est ExecuteMailer

pour les attachements par exemple j'ai une fonction (Add) dans la combo



l'éditeur fait appel à Attachments.Add dont voici le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
function TAttachments.Add: TAttachment;
begin
  Result := TAttachment.Create(FMailer.Owner);
  Result.SetParentComponent(FMailer);
end;

[ALWEBER]

Ci cela peut t'aider voici ce que j'utilise

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
 
unit uTreeComponent;
 
//AW Alain Weber
// 01/02/2013
// Version 0.1
 
interface
 
uses
  Classes, Controls;
 
type
  TTreeComponent = class(TComponent)
  public
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    function GetChildOwner: TComponent; override;
    function Serialisation: string;
  end;
 
procedure Deserialise(stSerialisation: String; O1: TComponent);
 
implementation
 
procedure Deserialise(stSerialisation: String; O1: TComponent);
var
  MS1, MS2: TMemoryStream;
  Sl1: TStringList;
begin
  if O1 = Nil then
    Exit;
  MS1 := TMemoryStream.Create;
  MS2 := TMemoryStream.Create;
  Sl1 := TStringList.Create;
  Sl1.text := stSerialisation;
  Sl1.SaveToStream(MS2);
  MS2.Seek(0, soFromBeginning);
  ObjectTextToBinary(MS2, MS1);
  MS1.Seek(0, soFromBeginning);
  MS1.ReadComponent(O1);
  Sl1.Free;
  MS2.Free;
  MS1.Free;
end;
 
function TTreeComponent.GetChildOwner: TComponent;
begin
  Result := Self;
end;
 
procedure TTreeComponent.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
  i1: integer;
begin
  for i1 := 0 to ComponentCount - 1 do
    Proc(TComponent(Components[i1]));
end;
 
function TTreeComponent.Serialisation: string;
var
  MS1, MS2: TMemoryStream;
  Sl1: TStringList;
begin
  MS1 := TMemoryStream.Create;
  MS2 := TMemoryStream.Create;
  Sl1 := TStringList.Create;
  MS1.WriteComponent(Self);
  MS1.Seek(0, soFromBeginning);
  ObjectBinaryToText(MS1, MS2);
  MS2.Seek(0, soFromBeginning);
  Sl1.LoadFromStream(MS2);
  Result := Sl1.text;
  Sl1.Free;
  MS2.Free;
  MS1.Free
end;
 
end.

[nicolas.bbs]

Bonjour Paul et Alweber,

Alweber, je n'ai pas du tout compris ta partie avec la sérialisation/désérialisation, mais tu m'as aiguillé sur une bonne solution avec la surcharge de getChildOwner qui permet de préciser au rechargement qu'on veut que le owner des sous-composants soit le composant parent et non la fiche. La fiche ne "connaissant plus du tout" les sous-composants, elle ne les affiche pas. Parfait ! Du coup ils n'apparaissent plus non plus dans la vue structure, mais ça n'est pas un problème pour moi.

L'affichage obtenu dans l'EDI pour les TAction contenus dans TActionList reste un mystérieux pour moi :
- le fait qu'ils n'apparaissent pas sur la fiche alors qu'elle en est le propriétaire
- le fait qu'ils soient classés par catégories dans la vue vue structure (=arborescence d'objets sur Delphi 6), alors que je ne vois rien dans le code en rapport avec ça : dans XE10.1 on a bien un énumérateur sur TActionList, mais sans rapport avec les catégories, et on a bien des fonctions EnumByCategory, mais ce sont de simples fonctions publiques et je ne vois pas comment l'EDI "saurait comment les utiliser". Et dans mon vieux Delphi 6, il n'y avait rien de tout ça, et l'affichage était le même !
Je suis donc de plus en plus convaincu que quelque-chose est géré dans l'éditeur de composant des TActionList, mais je ne trouve pas le code source de cet éditeur.

Je n'ai de toute façon malheureusement pas le temps de pousser ma curiosité au bout, je m'arrête donc à cette solution avec getChildOwner.

Merci à tous les deux !

[Paul TOTH]

en écrivant un nouveau composant j'ai redécouvert qu'on peut le supprimer avec RegisterNoIcon() tout simplement

[Lung]

en écrivant un nouveau composant j'ai redécouvert qu'on peut le supprimer avec RegisterNoIcon() tout simplement

C'est pas équivalent à

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Stored := False;

?

[nicolas.bbs]

Bonjour Paul,

Effectivement c'est tout simple. Pour cette fois je me suis rabattu sur la solution avec getChildOwner, mais la prochaine fois j'espère me souvenir de cette discussion pour avoir accès à mes sous-composants dans la vue structure.
Quand je regarde l'aide de Delphi je me dis que rien n'est fait pour qu'on trouve cette procédure : elle n'est citée dans aucune des pages qui parlent du recensement des composants. Il faut la rechercher explicitement par son nom pour la trouver.

Merci de t'être souvenu de cette discussion quand tu es retombé sur la solution !

[Paul TOTH]

C'est pas équivalent à

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Stored := False;

?

Stored ? dans property xxx stored = False; ?

ça sert à ce qu'une propriété ne soit pas enregistrée dans le DFM, la question était tout autre, comment faire en sorte qu'un sous-composant n'apparaisse pas sur la Fiche en conception

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
object Form1: TForm1
  object ComposantParent1: TComposantParent
    Left = 10
    Top = 10
    object ComposantEnfant1: TComposantEnfant1
    end
  end
end

du coup dans mon code j'ai

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
procedure Register;
begin
  RegisterComponents('Execute', [TComposantParent]);
  RegisterClasses([TComposantEnfant]); // pour qu'il puisse être lu depuis un DFM
  RegisterNoIcon([TComposantEnfant]); // pour qu'il soit invisible à la conception
end;

[Lung]

Stored ? dans property xxx stored = False; ?

ça sert à ce qu'une propriété ne soit pas enregistrée dans le DFM, la question était tout autre, comment faire en sorte qu'un sous-composant n'apparaisse pas sur la Fiche en conception

En fait, j'utilise Stored à False dans le constructeur de mes sous-composants. Et, je pensais que ça servait à ça.
Merci pour éclaircissement.