Création d'un composant RadioGroupBox

1 pièce(s) jointe(s)

Bonjour,

Cela fait déjà plus qu'un certain temps que je bosse en dilettante sur ce composant manquant (AMHA)
J'ai fait une grosse avancée il y a peu, jusqu'à présent il était bloqué sur le fait que la valeur liée se retrouvait dans le titre de la groupbox, en changeant de classe à dérivée (TLayout au lieu de GroupBox) c'est bon, du moins si je créé le composant au runtime.
J'ai également réussi à tester le Livebindings en créant mes liens également au runtime.
Reste un souci, la migration de l'unité en composant pour le créer au DesignTime

Pièce jointe 597455

Comme vous le constaterez sur l'image mon composant, à l'exécution, semble inactif :weird: contrairement à celui créé au runtime. Je n'arrive pas à en comprendre la raison

effectivement étrange, le source est regardante quelque part ?

1 pièce(s) jointe(s)

Quelques compilations/installations plus tard, sans en comprendre la raison, le composant est actif
De plus, un changement de style s'applique correctement. Chouette ça avance. :yaisse2:

Reste encore 3 points noirs
Pièce jointe 597457
certainement tous liés à une histoire entre runtime et designtime.

1 pièce(s) jointe(s)

Citation:

Envoyé par pprem

Effectivement étrange, le source est regardante quelque part ?

Je n'avais pas lu ta demande :oops: et effectivement sans le source difficile de suivre mes délires.

Il faudrait certainement que je le commente, change quelques noms de propriétés (à l'usage j'ai vu que certaines n'étaient pas pratiques à modifier)

A l'heure actuelle, en créant le radiogroupbox directement au runtime ça fonctionne nickel, en utilisant le composant installé ça plante encore.

Voici mon dernier jus, il y a encore deux points qui déconnent, le plus gros problème : le onclick ne fonctionne pas et un indice, le titre de la box semble doublé.
C'était comme si j'avais une double copie ou quelque chose du même genre (je m'y perds dans les ComponentState, OnCreate et OnPaint je pense).

Pièce jointe 597788

Code:

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
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
unit TRadioGroupBox;
 
interface
 
uses
  System.SysUtils, System.Classes, System.IOUtils, System.Math, System.Types,
  Data.Bind.Components,
  FMX.Types, FMX.Controls, FMX.Stdctrls, FMX.Objects, FMX.Layouts;
 
type
 
  TItem = Class(TCollectionItem)
  private
    FItemTexte: String;
    FItemValeur: String;
    procedure SetItemTexte(const Value: String);
    procedure SetItemValeur(const Value: String);
  published
    constructor create(const Texte, Valeur: String);
    property ItemTexte: String read FItemTexte write SetItemTexte;
    property ItemValeur: String read FItemValeur write SetItemValeur;
  end;
 
  TItemCollection<T: TItem> = class(TCollection)
  private
    FOwner: TComponent;
    FCollString: string;
  public
    constructor create(CollOwner: TComponent);
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  end;
 
  TBoutonsRadio = Class(TItemCollection<TItem>);
 
  [ObservableMembers('ItemValue')]
  TRadioGroupBoxFMX = class(TLayout)
  private
    FColumns: Word;
    FItemValue: String;
    FItemIndex: Integer;
    FRbItems: TBoutonsRadio;
    CLayout: TGridLayout;
    Group: TGroupBox;
    FTitre: String;
    procedure SetColumns(const Value: Word);
    procedure SetItemValue(const Value: String);
    procedure Change(Sender: TObject);
    procedure SetItemIndex(const Value: Integer);
    procedure SetrbItems(const Value: TBoutonsRadio);
    procedure ObserverToggle(const AObserver: IObserver; const Value: Boolean);
    function GetItemIndex: Integer;
    function rbItemsStored: Boolean;
    procedure SetTitre(const Value: String);
  protected
    function CanObserve(const ID: Integer): Boolean; override;
    { declaration is in System.Classes }
    procedure ObserverAdded(const ID: Integer; const Observer: IObserver);
      override; { declaration is in System.Classes }
    procedure RejectDragOver(Sender: TObject; const Data: TDragObject;
      const Point: TPointF; var Operation: TDragOperation);
    function FindValue(const V: String): Integer;
    function GetValue(const I: Integer): String;
    // procedure Loaded; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure OnResize;
    procedure RadioItemClick(Sender : TObject);
  public
    constructor create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AddItem(const Texte, Valeur: String);
    function Paint: Boolean; reintroduce;
  published
    property rbItems: TBoutonsRadio read FRbItems write SetrbItems
      stored rbItemsStored;
    property ItemValue: String read FItemValue write SetItemValue;
    property ItemIndex: Integer read GetItemIndex write SetItemIndex;
    property Columns: Word read FColumns write SetColumns stored Paint;
    property Titre: String read FTitre write SetTitre;
    property GridLayout: TGridLayout read CLayout; // debugging to remove
  end;
 
implementation
 
{ TItemCollection<T> }
constructor TItemCollection<T>.create(CollOwner: TComponent);
begin
  inherited create(T);
  FOwner := CollOwner;
end;
 
function TItemCollection<T>.GetOwner: TPersistent;
begin
  Result := FOwner;
end;
 
procedure TItemCollection<T>.Update(Item: TCollectionItem);
var
  str: string;
  I: Integer;
begin
  inherited;
  // update everything in any case...
  str := '';
  for I := 0 to Count - 1 do
  begin
    str := str + (Items[I] as TItem).ItemTexte;
    if I < Count - 1 then
      str := str + '-';
  end;
  FCollString := str;
end;
 
{ TItem }
constructor TItem.create(const Texte, Valeur: String);
begin
  FItemTexte := Texte;
  FItemValeur := Valeur;
end;
 
procedure TItem.SetItemTexte(const Value: String);
begin
  if Value <> FItemTexte then
    FItemTexte := Value;
end;
 
procedure TItem.SetItemValeur(const Value: String);
begin
  if Value <> FItemValeur then
    FItemValeur := Value;
end;
 
{ TFMXRadioGroupBox }
procedure TRadioGroupBoxFMX.AddItem(const Texte, Valeur: String);
var
  ARadio: TRadioButton;
  AItem: TItem;
begin
  try
    AItem := TItem(rbItems.Add);
    AItem.ItemTexte := Texte;
    AItem.ItemValeur := Valeur;
    ARadio := TRadioButton.create(CLayout);
    ARadio.Parent := CLayout;
    ARadio.Text := Texte;
    ARadio.OnChange := Change;
    ARadio.OnClick := RadioItemClick;
  except
 
  end;
end;
 
function TRadioGroupBoxFMX.CanObserve(const ID: Integer): Boolean;
begin
  case ID of
    TObserverMapping.EditLinkID, TObserverMapping.ControlValueID:
      Result := True;
  else
    Result := False;
  end;
end;
 
procedure TRadioGroupBoxFMX.Change(Sender: TObject);
var
  I: Integer;
  AObject: TFMXObject;
begin
  for I := 0 to Pred(CLayout.Children.Count) do
  begin
    AObject := CLayout.Children[I];
    if AObject is TRadioButton AND TRadioButton(AObject).IsChecked then
    begin
      FItemIndex := I;
      FItemValue := TItem(FRbItems.GetItem(I)).ItemValeur;
      Break;
    end;
  end;
  TLinkObservers.ControlChanged(Self);
end;
 
constructor TRadioGroupBoxFMX.create(AOwner: TComponent);
begin
  if not(csloading in ComponentState) then
  begin
    inherited;
    Width := 200;
    if not Assigned(Group) then
    begin
      Group := TGroupBox.create(Self);
      Group.Parent := Self;
      Group.Align := TAlignLayout.Contents;
      HitTest := False;
      Group.Text := FTitre;
      Group.Padding.Top := 20;
      Group.Padding.Left := 3;
      Group.Padding.Bottom := 3;
      Group.Padding.Right := 3;
    end;
    if Not Assigned(CLayout) then
    begin
      CLayout := TGridLayout.create(Self);
      // CLayout.Name:=Self.Name+'CLayout';
      CLayout.Parent := Group;
      CLayout.Position.Y := 0;
      CLayout.Position.X := 0;
      // CLayout.Width:=Group.Width-Group.Padding.Left-Group.Padding.Right;
      // CLayout.Height:=Group.Height-Group.Padding.Left-Group.Padding.Right;
      CLayout.HitTest := False;
      CLayout.Align := TAlignLayout.Client;
      CLayout.Stored := False;
    end;
    if (not(csloading in ComponentState)) OR (not Assigned(FRbItems)) then
      FRbItems := TBoutonsRadio.create(Self);
    FItemIndex := -1;
    FItemValue := '';
    FColumns := 1;
    SetAcceptsControls(False);
  end;
  Paint;
end;
 
destructor TRadioGroupBoxFMX.Destroy;
begin
  FreeAndNil(FRbItems);
  inherited;
end;
 
function TRadioGroupBoxFMX.FindValue(const V: String): Integer;
var
  I: Word;
begin
  for I := 0 to FRbItems.Count - 1 do
    if TItem(FRbItems.Items[I]).ItemValeur = V then
    begin
      FItemIndex := I;
      exit(I);
    end;
  Result := -1;
end;
 
function TRadioGroupBoxFMX.GetItemIndex: Integer;
begin
  if (ItemValue.IsEmpty) then
    Result := -1
  else
    Result := FindValue(ItemValue);
end;
 
function TRadioGroupBoxFMX.GetValue(const I: Integer): String;
begin
  if (I < 0) OR (I > rbItems.Count - 1) then
    Result := EmptyStr
  else
    Result := TItem(rbItems.Items[I]).ItemValeur;
end;
 
procedure TRadioGroupBoxFMX.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
 
end;
 
// procedure TFMXRadioGroupBox.Loaded;
// begin
// inherited;
// end;
 
procedure TRadioGroupBoxFMX.ObserverAdded(const ID: Integer;
  const Observer: IObserver);
begin
  if ID = TObserverMapping.EditLinkID then
    Observer.OnObserverToggle := ObserverToggle;
end;
 
procedure TRadioGroupBoxFMX.ObserverToggle(const AObserver: IObserver;
  const Value: Boolean);
var
  LEditLinkObserver: IEditLinkObserver;
begin
  if Value then
  begin
    if Supports(AObserver, IEditLinkObserver, LEditLinkObserver) then
      Enabled := not LEditLinkObserver.IsReadOnly;
  end
  else
    Enabled := True;
end;
 
procedure TRadioGroupBoxFMX.OnResize; // design uniquement ?
begin
  Paint;
end;
 
function TRadioGroupBoxFMX.Paint: Boolean;
var
  Rows, I: Word;
  ARadio: TRadioButton;
  cLayoutW, cLayoutH: Single;
begin
  if not (csloading in ComponentState) then Exit;
  if Assigned(Group) then
  begin
    CLayout.DeleteChildren;
    cLayoutW := Self.Width - Group.Padding.Left - Group.Padding.Right;
    CLayout.ItemWidth := Trunc(CLayoutW / FColumns);
    cLayoutH := Group.Height - Group.Padding.Top - Group.Padding.Bottom;
    if rbItems.Count <= 1 then
      CLayout.ItemHeight := CLayout.Height
    else
    begin
      if rbItems.Count mod FColumns = 0 then
        Rows := rbItems.Count div FColumns
      else
        Rows := (rbItems.Count div FColumns) + 1;
      CLayout.ItemHeight := cLayoutH / Rows;
    end;
    if rbItems.Count = 0 then
      exit;
    for I := 0 to rbItems.Count - 1 do
    begin
      ARadio := TRadioButton.create(CLayout);
      ARadio.HitTest:=True;
      ARadio.Parent := CLayout;
      ARadio.Text := TItem(rbItems.Items[I]).ItemTexte;
      ARadio.IsChecked:=(I=ItemIndex);
      ARadio.OnChange := Change;
    end;
    Result := True;
  end;
end;
 
procedure TRadioGroupBoxFMX.RadioItemClick(Sender: TObject);
begin
//
end;
 
function TRadioGroupBoxFMX.rbItemsStored: Boolean;
begin
  Result := True;
end;
 
procedure TRadioGroupBoxFMX.RejectDragOver(Sender: TObject;
  const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation);
begin
  Operation := TDragOperation.None;
end;
 
procedure TRadioGroupBoxFMX.SetColumns(const Value: Word);
begin
  if FColumns <> Value then
  begin
    FColumns := Value;
    Paint;
  end;
end;
 
procedure TRadioGroupBoxFMX.SetItemIndex(const Value: Integer);
begin
  if csloading in ComponentState then
    exit;
  if (Value <> FItemIndex) AND (Value <= FRbItems.Count) then
  begin
    FItemIndex := Value;
    FItemValue := EmptyStr;
    if FItemIndex >= 0 then
    begin
      TRadioButton(CLayout.Children[FItemIndex]).IsChecked := True;
      FItemValue := GetValue(FItemIndex);
      //
      Paint;
    end;
  end;
end;
 
procedure TRadioGroupBoxFMX.SetrbItems(const Value: TBoutonsRadio);
var
  I: Integer;
begin
  CLayout.DeleteChildren;
  FRbItems.Assign(Value);
  for I := 0 to FRbItems.Count - 1 do
    AddItem(TItem(FRbItems.Items[I]).ItemTexte, TItem(FRbItems.Items[I])
      .ItemValeur);
  // Paint;
end;
 
procedure TRadioGroupBoxFMX.SetTitre(const Value: String);
begin
  FTitre := Value;
  if Assigned(Group) then
    Group.Text := FTitre;
end;
 
procedure TRadioGroupBoxFMX.SetItemValue(const Value: String);
var
  I: Integer;
begin
  if csloading in ComponentState then
    exit;
 
  if Value <> FItemValue then
  begin
    FItemValue := Value;
    I := FindValue(Value);
    FItemIndex := I;
    if I >= 0 then
      TRadioButton(CLayout.Children[I]).IsChecked := True
    else
      FItemValue := EmptyStr;
    TLinkObservers.ControlChanged(Self);
  end;
end;
 
initialization
 
Data.Bind.Components.RegisterObservableMember
  (TArray<TClass>.create(TRadioGroupBoxFMX), 'ItemValue', 'FMX');
 
finalization
 
Data.Bind.Components.UnregisterObservableMember
  (TArray<TClass>.create(TRadioGroupBoxFMX));
 
end.

pour info quand je fait une création au runtime

Code:

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
 
// Création d'un groupe
procedure TForm39.Button1Click(Sender: TObject);
begin
rdgb:=TRadioGroupBoxFMX.Create(Self);
rdgb.Name:='rdgb';
rdgb.Parent:=Self;
rdgb.Position.X:=10;
rdgb.Position.Y:=Button1.Position.Y+Button1.Height+5;
rdgb.Width:=400;
rdgb.Height:=80;
rdgb.Titre :='Test';
rdgb.HitTest:=False;
rdgb.Columns:=3;
end;
 
// ajout un élément
procedure TForm39.AjouterClick(Sender: TObject);
begin
 rdgb.addItem(Format('e%d v%s',[rdgb.rbItems.Count,Char(65+rdgb.rbItems.Count)]),Char(65+rdgb.rbItems.Count));
 rdgb.Paint;
end;
 
// Liaison
procedure TForm39.btnLierClick(Sender: TObject);
var LinkControl : TLinkControlToField;
begin
  LinkControl := TLinkControlToField.Create(Self);
  LinkControl.DataSource := BindSourceDB1;
  LinkControl.FieldName := 'Valeur';
  LinkControl.Control := rdgb;
  LinkControl.Track := True;
  LinkControl.Active:=True;
end;

Bonjour,

Citation:

C'était comme si j'avais une double copie

Je confirme, j'ai ajouté dans mon programme test un bouton avec le code suivant
Code:

1 2 3 4 5 6 procedure TForm39.btnValeurClick(Sender: TObject); begin ShowMessage(RadiogroupBoxFMX1.ChildrenCount.ToString); // résultat 2 RadioGroupboxFMX1.Children[1].Destroy; end;
Après destruction de ce "double" le composant fonctionne comme je l'espère.

Donc, à priori, c'est le OnCreate ou le Paint qui déconne

Salut, j'ai pas tout regardé mais là, y'a des trucs qui piquent les yeux :)

Code:

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
 
constructor TRadioGroupBoxFMX.create(AOwner: TComponent);
begin
  if not(csloading in ComponentState) then
  begin
    inherited; // <<< faut toujours appeler inherited !
    Width := 200;
    if not Assigned(Group) then // dans un constructor ça ne risque pas d'arriver
    begin
      Group := TGroupBox.create(Self);
      Group.Parent := Self;
      Group.Align := TAlignLayout.Contents;
      HitTest := False;
      Group.Text := FTitre;
      Group.Padding.Top := 20;
      Group.Padding.Left := 3;
      Group.Padding.Bottom := 3;
      Group.Padding.Right := 3;
    end;
    if Not Assigned(CLayout) then // idem
    begin
      CLayout := TGridLayout.create(Self);
      // CLayout.Name:=Self.Name+'CLayout';
      CLayout.Parent := Group;
      CLayout.Position.Y := 0;
      CLayout.Position.X := 0;
      // CLayout.Width:=Group.Width-Group.Padding.Left-Group.Padding.Right;
      // CLayout.Height:=Group.Height-Group.Padding.Left-Group.Padding.Right;
      CLayout.HitTest := False;
      CLayout.Align := TAlignLayout.Client;
      CLayout.Stored := False;
    end;
    if (not(csloading in ComponentState)) OR (not Assigned(FRbItems)) then // tu n'as pas déjà testé csLoading ? et idem
      FRbItems := TBoutonsRadio.create(Self);
    FItemIndex := -1;
    FItemValue := '';
    FColumns := 1;
    SetAcceptsControls(False);
  end;
  Paint; // dans un constructor ?!
end;

Bonjour,

Effectivement, à force de vouloir trouver le pourquoi de la double copie j'ai fini par merder dans les grandes largeurs :oops:
merci de me l'avoir signaler de toute façon ComponentState=[] donc j'y passe
Pour le paint c'est déjà commenté

Ouf, je crois avoir trouvé : un Group.Stored:=False manquant dans le OnCreate.
Je tacherai de vérifier de nouveau le tout (surtout le mode design) cet après midi avant de mettre un :resolu:
Restera ensuite de la cosmétique de noms de propriétés pour avoir quelque chose de facile à remplir (toujours au design)

ce qui est certains c'est que je passe souvent plus de temps à rendre un composant utilisable dans l'IDE qu'à le créer au départ :)

le pb de l'IDE c'est que les paramètres sont modifiés en temps réel dans un ordre arbitraire et parfois contre intuitif, alors que dans le code on le fait rarement...par exemple on activera toujours un DataSet avant de lire les champs, mais en designtime on peut vouloir regarder les champs d'un dataset inactif

là il faut aussi savoir que l'ordre de déclaration des propriétés a un impacte sur la création du DFM...si par exemple je place Active en premier, c'est la première propriété qui sera lue, alors que c'est souvent la dernière dont on a besoin :)

1 pièce(s) jointe(s)

J'en suis au peaufinage :

- Comment au design mettre le nom du composant dans le titre du groupe ?
j'ai écris ceci dans le Paint

Code:

if (csDesigning in ComponentState) AND (FTitre.IsEmpty) then Group.Text:=Self.Name;

Je me demande s'il y a mieux ?
de plus j'ai un petit truc (inhérent au style, avec celui-ci on le voit bien) qui me chagrine : un groubox sans texte laisse un espace vide
Pièce jointe 597873

- J'ai encore un léger souci en monocolonne (columns=1) fonctionne au design mais n'affiche aucun item au runtime :weird:
Je vais suivre ta piste d'ordre des propriétés

exemple pour le nom

Code:

1
2
3
4
5
6
7
8
9
10
11
 
procedure TPresentedTextControl.SetName(const Value: TComponentName);
var
  ChangeText: Boolean;
begin
  ChangeText := not (csLoading in ComponentState) and (Name = Text) and
    ((Owner = nil) or not (csLoading in TComponent(Owner).ComponentState));
  inherited SetName(Value);
  if ChangeText then
    Text := Value;
end;

pour le titre, je n'ai pas vu où il est était défini

Citation:

Envoyé par SergioMaster

Ouf, je crois avoir trouvé : un Group.Stored:=False manquant dans le OnCreate.

Me fait avoir souvent avec ça quand je crée les composants qui en créent d'autres dans leur arborescence.

Le truc qui devrait être dans la FAQ ;)

@pprem J'ai toujours l'intention d'écrire un tutoriel pour cette partie (la suite de https://serge-girard.developpez.com/...s/Composant_A/ promise)

Citation:

Envoyé par Paul Toth

ce qui est certains c'est que je passe souvent plus de temps à rendre un composant utilisable dans l'IDE qu'à le créer au départ

Je confirme, mes "peaufinages" ont rendu le composant inutilisable. Il faut que je reprenne de la hauteur (dernier utilisable), j'arrête avant de faire des dommages irréparables.