Discussion :

[SergioMaster]

Bonjour,

toujours à fond dans mon délire j'entame une nouvelle étape : la création d'un équivalent TDBRadioGroupBox.

Mes premiers essais en créant le composant au runtime sont plus ou moins concluant
Premiers essais en utilisant une propriété TStrings

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
 
  TRadioGroupBoxPair = Class(TGroupBox)
   private
    FColumns : Word;
    FValue : String;
    FItems : TStrings;
    FIndexItem : Integer;
    CBLayout : TGridLayout;
    procedure SetColumns(const Value: word);
    procedure SetValue(const Value: string);
    procedure Change(Sender : TObject);
    procedure SetIndexItem(const Value: Integer);
    procedure SetItems(const Value: TStrings);
  protected
    function FindValue(const V : String) : Integer;
    procedure OnResize;
  public
   constructor Create(AOwner : TComponent); override;
   destructor Destroy; override;
   procedure AddItem(const Text : String; const Value : String);
   function Paint : Boolean; reintroduce;
  published
    property Items : TStrings read FItems write SetItems;
    property Value : String read FValue write setValue;
    property IndexItem : Integer read FIndexItem write SetIndexItem;
    property Columns : word read FColumns write SetColumns stored Paint;
  end;
 
implementation
 
 
{ TRadioGroupBoxPair }
 
procedure TRadioGroupBoxPair.AddItem(const Text, Value: String);
var ARadio : TRadioButton;
begin
FItems.AddPair(Text,Value);
if FItems.Count>0
   then CBLayout.ItemHeight:=CBLayout.Height/(FItems.Count*FColumns)
   else CBLayout.ItemHeight:=CBLayout.Height;
ARadio:=TRadioButton.Create(CBLayout);
ARadio.Parent:=CBLayout;
ARadio.Text:=Text;
ARadio.Tag:=FItems.Count+1;
ARadio.TagString:=Value;
ARadio.OnChange:=Change;
ARadio.Name:=format('%sRadio%d',[self.Name,FItems.Count]);
end;
 
procedure TRadioGroupBoxPair.Change(Sender: TObject);
var i : Integer;
    AObject : TFMXObject;
begin
for i:=0 to Pred(CBLayout.Children.Count) do
 begin
   AObject:=CBLayout.Children[i];
   if AObject is TRadioButton AND TRadioButton(AObject).IsChecked
     then begin
      FValue:=AObject.TagString;
      FIndexItem:=AObject.Tag;
      Break;
     end;
 end;
end;
 
constructor TRadioGroupBoxPair.Create(AOwner: TComponent);
begin
  inherited;
 
  FIndexItem:=-1;
  FColumns:=1;
  Width:=200;
  Padding.Top:=20;
  Padding.Left:=3;
  Padding.Bottom:=3;
  Padding.Right:=3;
  CBLayout:=TGridLayout.Create(Self);
  CBLayout.Name:=Self.Name+'CBLayout';
  CBLayout.ItemHeight:=Width-Padding.Left-Padding.Right;
  CBLayout.ItemHeight:=24;
  CBLayout.Parent:=Self;
  CBLayout.Align:=TAlignLayout.Client;
  CBLayout.OnDragOver:=OnDragOver;
  FItems:=TStringList.Create;
end;
 
destructor TRadioGroupBoxPair.Destroy;
begin
  FreeAndNil(CBLayout);
  FreeAndNil(FItems);
  inherited;
end;
 
 
function TRadioGroupBoxPair.FindValue(const V: String): Integer;
var i : Integer;
begin
 result:=-1;
 for i:=0 to Pred(FItems.Count) do
     if //FItems.Values[FItems.Names[i]]=V
        FItems.ValueFromIndex[i]=V
      then
       begin
         result:=i;
         exit;
       end;
end;
 
 
procedure TRadioGroupBoxPair.OnResize;
begin
  Paint;
end;
 
function TRadioGroupBoxPair.Paint : Boolean;
var Rows : word;
begin
   CBLayout.Width:=Self.Width-Padding.Top-Padding.Bottom;
   CBLayout.ItemWidth:=CBLayout.Width/FColumns;
   CBLayout.Height:=Self.Height-Padding.Top-Padding.Bottom;
   if FItems.Count>0 then
      begin
       Rows:=FItems.Count mod FColumns;
       Rows:=IfThen(Rows>0,FItems.Count div FColumns +1,FItems.Count div FColumns);
       CBLayout.ItemHeight:=CBLayout.Height/Rows;
     end;
  result:=true;
end;
 
procedure TRadioGroupBoxPair.SetColumns(const Value: word);
begin
  if FColumns<>Value then
   begin
    FColumns := Value;
    Paint;
   end;
end;
 
procedure TRadioGroupBoxPair.SetIndexItem(const Value: Integer);
var aRB : TFMXObject;
begin
  if Value <> FIndexItem then
    begin
     FIndexItem := Value;
     if FIndexItem>=0 then
         TRadioButton(CBLayout.Children[FIndexItem]).IsChecked:=true
     else
       for aRB in CBLayout.Children do
          if aRB is TRadioButton then TRadioButton(aRB).isChecked:=False;
     Paint;
    end;
 
end;
 
procedure TRadioGroupBoxPair.SetItems(const Value: TStrings);
var i : Word;
begin
  if FItems.CommaText<>Value.CommaText then
   begin
     CBLayout.DeleteChildren;
     for i:=0 to Pred(Value.Count) do
      AddItem(Value.Names[i],Value.Values[Value.Names[i]]);
     Paint;
   end;
end;
 
procedure TRadioGroupBoxPair.setValue(const Value: String);
begin
  FValue := Value;
  FIndexItem:=FindValue(Value);
  if FIndexItem>=0 then
   begin
    TRadioButton(CBLayout.Children[FIndexItem]).IsChecked:=true;
    Paint;
   end;
end;

utilisation

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
RB:=TRadioGroupBoxPair.Create(Self);
Rb.Text:='Essai';
Rb.Columns:=Word(Trunc(SpinBox1.Value));
RB.Parent:=Self;
RB.Position.X:=230;
RB.Position.Y:=15;
RB.AddItem('Valeur 1','1');
RB.AddItem('Valeur 2','2');
RB.AddItem('Valeur 3','3');
RB.Paint;

Au niveau du runtime cela fonctionne. Inconvénient quand il s'agit d'en faire un composant donc au moment du design, remplir la liste des boutons via un TStrings c'est pas très naturel

Valeur 1=1
Valeur 2=2
Valeur 3=3

j'ai donc changé ma propriété en TCollection

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
TItem = Class (TCollectionItem)
  private
    FTexte : String;
    FValeur : STring;
    procedure SetTexte(const Value: String);
    procedure SetValeur(const Value: String);
  published
    property Texte : String read FTexte write SetTexte;
    property Valeur : String read FValeur write SetValeur;
  end;
 
 
 TItemCollection<T: TItem> = class(TCollection)
  protected
    function GetItem(Index: Integer): T;
    procedure SetItem(Index: Integer; Value: T);
    procedure Notify(Item: TCollectionItem; Action: System.Classes.TCollectionNotification); override;
 public
    constructor Create;
    function Add: T;
    function FindItemID(ID: Integer): T;
    property Items[Index: Integer]: T read GetItem write SetItem;
  end;
 
 TRadioGroupItems = class(TItemCollection<TItem>);
 
 TRadioGroupBoxCollection = class(TGroupBox)
   private
    FColumns : Word;
    FValue : String;
    FIndexItem : Integer;
    FItems : TRadioGroupItems;
    CLayout : TGridLayout;
    procedure SetColumns(const Value: word);
    procedure SetValue(const Value: string);
    procedure Change(Sender : TObject);
    procedure SetIndexItem(const Value: Integer);
    procedure SetItems(const Value: TRadioGroupItems);
  protected
    function FindValue(const V : String) : Integer;
    procedure OnResize;
  public
   constructor Create(AOwner : TComponent); override;
   destructor Destroy; override;
   procedure AddItem(const Text : String; const Value : String);
   function Paint : Boolean; reintroduce;
  published
    property Items : TRadioGroupItems read FItems write SetItems;
    property Value : String read FValue write setValue;
    property IndexItem : Integer read FIndexItem write SetIndexItem;
    property Columns : word read FColumns write SetColumns stored Paint;
  end;

Ce qui me permet de proposer ce genre de saisie des différents Items

Génial, sauf que je n'arrive pas à faire le lien entre la modification des items et le dessin (ce qui au runtime se fait par addItem)
à mon avis cela se joue avec la procedure Notify de TItemCollection mais je ne vois pas comment accéder au AddItem du coup mon groupe radio n'affiche rien

une idée ?

[Paul TOTH]

ta collection a besoin d'une référence au composant

Code :

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

1
2
3
4
5
6
7
8
 
type
  TRadioGroupItems = class(TItemCollection<TItem>)
  private
     FRadioGroup: TRadioGroupBoxCollection;
  protected
    procedure Update(Item: TCollectionItem); override;
  end;

et dans Update() tu invalide le radiogroup par exemple (à voir selon ton code)

[SergioMaster]

Bonjour,

Effectivement, il manquait une référence au composant, j'ai rajouté une propriété Owner pour pouvoir y accéder
mais il y a encore un hic

les boutons se créent avant que les indications soient mises (dès l'ajout de l'item )
Je vais laisser reposer les yeux et reprendrai le chantier un autre jour

Merci de t'y être intéressé

[SergioMaster]

Bonjour,

J'ai pour l'instant abandonné la piste collection pour me pencher sur le cœur du composant. Pour l'instant je me contente de TStringList (un pour les libellés des boutons et un pour les valeurs associées)

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
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
 
 unit SRadioGroupBox;
 
interface
 
uses
  System.SysUtils, System.Classes, System.IOUtils, System.Math, System.Types,
  System.Generics.Collections, FMX.dialogs,
  FMX.Types, FMX.Controls, FMX.Stdctrls, FMX.Objects, FMX.Layouts;
 
type
  TRadioEvent = procedure (sender : TObject) of Object;
 
  [ObservableMembers('grbValue')]
  TSRadioGroupBox = class(TGroupBox)
  strict private
    FIndexItem : Integer;
  private
    FChangedRadioButton : TRadioEvent;
    FColumns : Word;
    FrbValue : String;
    FrbItems  : TStringList;
    FrbValues : TStringList;
    CLayout : TGridLayout;
    procedure SetColumns(const Value: word);
    procedure SetgrbValue(const Value: string);
//    procedure SetIndexItem(const Value: Integer);
    procedure SetrbItems(const Value: TStringList);
    procedure SetrbValues(const Value: TStringList);
    procedure ObserverToggle(const AObserver: IObserver; const Value: Boolean);
    procedure ChangeRadioButton(Sender: TObject);
  protected
    property ChangedRadioButton : TRadioEvent read FChangedRadioButton write FChangedRadioButton;
    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 }
  protected
    function FindValue(const V : String) : Integer;
    procedure OnResize;
  public
   constructor Create(AOwner : TComponent); override;
   destructor Destroy; override;
   procedure AddItem(const Text : String);
   function Paint : Boolean; reintroduce;
  published
    property rbItems : TStringList read FrbItems write SetrbItems;
    property rbValues : TStringList read FrbValues write SetrbValues;
    property grbValue : String read FrbValue write setgrbValue;
    property IndexItem : Integer read FIndexItem; // write SetIndexItem;
    property Columns : word read FColumns write SetColumns stored Paint;
  end;
 
implementation
 
procedure TSRadioGroupBox.AddItem(const Text : String);
var ARadio : TRadioButton;
begin
try
 ARadio:= TRadioButton.Create(Clayout);
 ARadio.Text:=Text;
 ARadio.OnClick:=ChangedRadioButton;
 CLayout.AddObject(ARadio);
except
end;
end;
 
function TSRadioGroupBox.CanObserve(const ID: Integer): Boolean;
begin
  case ID of
    TObserverMapping.EditLinkID,
    TObserverMapping.ControlValueID: Result := True;
  else
    Result := False;
  end;
end;
 
procedure TSRadioGroupBox.ChangeRadioButton(Sender: TObject);
var i : Integer;
    ARadioButton : TRadioButton;
begin
Showmessage('click');
{for ARadioButton in FRadioButtons do
 begin
   if (aRadioButton=Sender) And ARadioButton.IsChecked
     then begin
      FrbValue:=i.ToString;
      if FrbValues.Count>0 then FrbValue:=frbValues[i];
      FIndexItem:=i;
      Break;
     end;
 end;}
end;
 
constructor TSRadioGroupBox.Create(AOwner: TComponent);
begin
  inherited;
  FIndexItem:=-1;
  FColumns:=1;
  FChangedRadioButton:=ChangeRadioButton;
  Width:=200;
  Padding.Top:=20;
  Padding.Left:=3;
  Padding.Bottom:=3;
  Padding.Right:=3;
//  if (csDesigning in ComponentState) then
//    begin
    CLayout:=TGridLayout.Create(Self);
    CLayout.Align:=TAlignLayout.Client;
    CLayout.Parent:=Self;
    CLayout.SetSubComponent(True);
//    CLayout.Stored := False;
//     CLayout.OnDragOver:=OnDragOver;
//    end;
  if not Assigned(Frbitems) then FrbItems:=TStringList.Create;
  if not Assigned(FrbValues) then frbValues:=TStringList.Create;
end;
 
destructor TSRadioGroupBox.Destroy;
begin
  FreeAndNil(FrbItems);
  FreeAndNil(FrbValues);
  FreeAndNil(CLayout);
  inherited;
end;
 
 
function TSRadioGroupBox.FindValue(const V: String): Integer;
var i : word;
begin
for i:=0 to FrbValues.Count-1 do
  begin
   if FrbValues[i]=V then
     begin
       FrbValue:=V;
       FIndexItem:=i;
       Exit(i);
     end;
  end;
FrbValue:=EmptyStr;
result:=-1;
end;
 
procedure TSRadioGroupBox.ObserverAdded(const ID: Integer;
  const Observer: IObserver);
begin
  if ID = TObserverMapping.EditLinkID then
    Observer.OnObserverToggle := ObserverToggle;
end;
 
procedure TSRadioGroupBox.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 TSRadioGroupBox.OnResize;
begin
Paint;
end;
 
function TSRadioGroupBox.Paint : Boolean;
var Rows : word;
begin
  CLayout.Width:=Self.Width-Self.Padding.Left-Self.Padding.Right;
  CLayout.ItemWidth:=CLayout.Width/FColumns;
  CLayout.Height:=Self.Height-Self.Padding.Top-Self.Padding.Bottom;
  if frbItems.Count<=1
   then CLayout.ItemHeight:=CLayout.Height
   else  begin
         if FrbItems.Count mod FColumns=0
               then Rows:=frbItems.Count div FColumns
               else Rows:=(frbItems.Count div FColumns) + 1;
          CLayout.ItemHeight:=CLayout.Height/Rows;
   end;
  result:=true;
end;
 
procedure TSRadioGroupBox.SetColumns(const Value: word);
begin
  if FColumns<>Value then
   begin
    FColumns := Value;
    Paint;
   end;
end;
 
//procedure TSRadioGroupBox.SetIndexItem(const Value: Integer);
//begin
//if (Value<>FIndexItem) AND (Value<=FrbItems.Count) then
// begin
//   FIndexItem:=Value;
//   if FIndexItem>=0 then
//   begin
//    TRadioButton(CLayout.Children[FIndexItem]).IsChecked:=true;
//    Paint;
//   end;
// end;
//end;
 
 
procedure TSRadioGroupBox.SetrbItems(const Value: TStringList);
var  i : Integer;
     Valeur : String;
begin
  CLayout.DeleteChildren;
  FrbItems.Assign(Value);
  for i := 0 to  frbItems.Count-1 do
    begin
     try
      Valeur:=frbValues[i];
     except
      Valeur:=i.ToString;
     end;
     AddItem(FrbItems[i]);
    end;
  Paint;
end;
 
procedure TSRadioGroupBox.SetrbValues(const Value: TStringList);
begin
  FrbValues.Assign(Value);
end;
 
 
procedure TSRadioGroupBox.SetgrbValue(const Value: string);
var i,R : Integer;
begin
 if Value<>FrbValue then
  begin
   i:=FindValue(Value);
   for r :=0 to Clayout.ChildrenCount-1 do
     begin
      TRadioButton(CLayout.Children[r]).IsChecked:=(r=i);
      if r=1 then break ;
     end;
   Paint;
  end;
end;
 
end.

Premier problème sur le Create ce n'est pas qu'il fonctionne pas en mode design OK, en mode runtime il semble être OK mais
je me retrouve avec deux gridlayout soit un de trop !

object SRadioGroupBox1: TSRadioGroupBox
Padding.Left = 3.000000000000000000
Padding.Top = 20.000000000000000000
Padding.Right = 3.000000000000000000
Padding.Bottom = 3.000000000000000000
Position.X = 40.000000000000000000
Position.Y = 72.000000000000000000
Size.Width = 200.000000000000000000
Size.Height = 100.000000000000000000
Size.PlatformDefault = False
Text = 'SRadioGroupBox1'
TabOrder = 3
rbItems.Strings = (
'AAA'
'BBB'
'CCC')
Columns = 1
object TGridLayout
Align = Client
ItemHeight = 25.666666030883790000
ItemWidth = 194.000000000000000000
Orientation = Horizontal
Size.Width = 194.000000000000000000
Size.Height = 77.000000000000000000
Size.PlatformDefault = False
TabOrder = 1
end
object TGridLayout
Align = Client
ItemHeight = 25.666666030883790000
ItemWidth = 194.000000000000000000
Orientation = Horizontal
Size.Width = 194.000000000000000000
Size.Height = 77.000000000000000000
Size.PlatformDefault = False
TabOrder = 2
end
object TGridLayout
Align = Client
ItemHeight = 25.666666030883790000
ItemWidth = 194.000000000000000000
Orientation = Horizontal
Size.Width = 194.000000000000000000
Size.Height = 77.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
object TRadioButton
Size.Width = 194.000000000000000000
Size.Height = 25.666666030883790000
Size.PlatformDefault = False
TabOrder = 0
Text = 'AAA'
end
object TRadioButton
Position.Y = 25.666666030883790000
Size.Width = 194.000000000000000000
Size.Height = 25.666666030883790000
Size.PlatformDefault = False
TabOrder = 1
Text = 'BBB'
end
object TRadioButton
Position.Y = 51.333332061767580000
Size.Width = 194.000000000000000000
Size.Height = 25.666666030883790000
Size.PlatformDefault = False
TabOrder = 2
Text = 'CCC'
end
end
end

si j'utilise CLayout.Stored := False; : plus de boutons radio au runtime

Deuxième problème le onChange des boutons radios , je ne sais absolument pas comment l'indiquer au niveau du composant

Troisième problème l'objectif est de lier la property grbValue, gag, j'ai beau faire c'est la propriété text de ma groupbox qui change !

si quelques pistes pour les points 1 et 2 vous viennent à l'esprit je suis preneur

[SergioMaster]

Bonjour,

Cela fait plus d'un an que je ne m'étais pas penché dessus. Il était temps de reprendre l'ouvrage

Voilà donc le source du package

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
package PackageTest;
 
{$R *.res}
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO OFF}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION OFF}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES ON}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DEFINE DEBUG}
{$ENDIF IMPLICITBUILDING}
{$IMPLICITBUILD ON}
 
requires
  rtl,
  fmx,
  bindengine,
  bindcomp;
 
contains
  CRadioGroupBox in 'CRadioGroupBox.pas',
  RegisterCompo in 'RegisterCompo.pas';
 
end.

de l'unité d'enregistrement du composant

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
 
unit RegisterCompo;
 
interface
uses System.Classes, Data.Bind.Components;
 
procedure Register;
 
implementation
uses CRadioGroupbox;
 
procedure Register;
begin
   RegisterComponents('Tutoriel',[TFMXRadioGroupBox]);
end;
 
initialization
  Data.Bind.Components.RegisterObservableMember(TArray<TClass>.Create(
    TFMXRadioGroupBox),
    'ItemValue', 'FMX');
finalization
  Data.Bind.Components.UnregisterObservableMember(TArray<TClass>.Create(
    TFMXRadioGroupBox));
end.

Du composant sensu stricto

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
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
unit CRadioGroupBox;
 
interface
 
uses
  System.SysUtils, System.Classes, System.IOUtils, System.Math, System.Types,
  FMX.Dialogs,
  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')]
  TFMXRadioGroupBox = class(TGroupBox)
   private
    FColumns : Word;
    FItemValue : String;
    FItemIndex : Integer;
    FrbItems  : TBoutonsRadio;
    CLayout : TGridLayout;
    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);
  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 }
  protected
    function FindValue(const V : String) : Integer;
    procedure OnResize;
  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;
    property ItemValue : String read FItemValue write SetItemValue;
    property IndexItem : Integer read FItemIndex write SetItemIndex;
    property Columns : word read FColumns write SetColumns stored Paint;
  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 TFMXRadioGroupBox.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;
except
 
end;
end;
 
function TFMXRadioGroupBox.CanObserve(const ID: Integer): Boolean;
begin
  case ID of
    TObserverMapping.EditLinkID,
    TObserverMapping.ControlValueID: Result := True;
  else
    Result := False;
  end;
end;
 
procedure TFMXRadioGroupBox.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;
end;
 
constructor TFMXRadioGroupBox.Create(AOwner: TComponent);
begin
  inherited;
  FItemIndex:=-1;
  FItemValue:='';
  FColumns:=1;
  Width:=200;
  Padding.Top:=20;
  Padding.Left:=3;
  Padding.Bottom:=3;
  Padding.Right:=3;
  if Not Assigned(CLayout) then
    begin
     CLayout:=TGridLayout.Create(Self);
//     CLayout.Name:=Self.Name+'CLayout';
     CLayout.Parent:=Self;
     CLayout.Align:=TAlignLayout.Client;
     CLayout.Stored:=False;
//     CLayout.OnDragOver:=OnDragOver;    // design
    end;
  if not Assigned(Frbitems) then FrbItems:=TBoutonsRadio.Create(Self);
  if rbItems.Count>0 then Paint;
end;
 
destructor TFMXRadioGroupBox.Destroy;
begin
  FreeAndNil(frbItems);
  inherited;
end;
 
function TFMXRadioGroupBox.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;
 
procedure TFMXRadioGroupBox.ObserverAdded(const ID: Integer;
  const Observer: IObserver);
begin
if ID = TObserverMapping.EditLinkID then
    Observer.OnObserverToggle := ObserverToggle;
end;
 
procedure TFMXRadioGroupBox.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 TFMXRadioGroupBox.OnResize;  // design uniquement ?
begin
 Paint;
end;
 
function TFMXRadioGroupBox.Paint: Boolean;
var Rows,I : word;
    ARadio : TRadioButton;
    cLayoutW,cLayoutH : Single;
begin
  result:=true;
  cLayoutW:=Self.Width-Self.Padding.Left-Self.Padding.Right;
  CLayout.ItemWidth:=Trunc(cLayoutW/FColumns);
  cLayoutH:=Self.Height-Self.Padding.Top-Self.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;
  CLayout.DeleteChildren;   // uniquement design
  if rbItems.count=0 then exit;
  for I := 0 to rbItems.count -1 do
    begin
       ARadio:= TRadioButton.Create(CLayout);
       ARadio.Parent:=CLayout;
       ARadio.Text:=TItem(rbItems.Items[i]).ItemTexte;
       ARadio.Stored:=False;
       ARadio.OnChange:=Change;
    end;
 
end;
 
procedure TFMXRadioGroupBox.SetColumns(const Value: word);
begin
  if FColumns<>Value then
   begin
    FColumns := Value;
    Paint;
   end;
end;
 
procedure TFMXRadioGroupBox.SetItemIndex(const Value: Integer);
begin
if (Value<>FItemIndex) AND (Value<=FrbItems.Count) then
 begin
   FItemIndex:=Value;
   if FItemIndex>=0 then
   begin
    TRadioButton(CLayout.Children[FItemIndex]).IsChecked:=true;
  //  Paint;
   end;
 end;
end;
 
procedure TFMXRadioGroupBox.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 TFMXRadioGroupBox.SetItemValue(const Value: string);
var i : Integer;
begin
 if Value<>FItemValue then
  begin
   i:=FindValue(Value);
   if i>=0 then TRadioButton(CLayout.Children[FItemIndex]).IsChecked:=true
   else FItemValue:='';
//    Paint;
  end;
end;
 
end.

Il y a encore du travail à fournir et je ne parle pas de l'harmonisation des noms des variables, ni des cibles OS à définir (desktop uniquement ?).
Au stade actuel voilà le bilan :
Au design :
La partie visuelle fonctionne mais le bouton radio de l'item actif n'est pas "coché" si je change la valeur de ItemIndex ou ItemValue
ou plutôt dirais-je que le ce dernier est sélectionné une poignée de milliseconde avant de reprendre son état antérieur , les valeurs elles étant bien mises à jour.
Livebindings, je peux bien lier le composant, le comportement semble correct quand je navigue dans les données


Au runtime : rien ne fonctionne
- les boutons radios ne sont pas dessinés , les éléments ne semblent pas être définis et donc à partir de là je ne peux qu'obtenir une erreur

Toutes suggestions ou critiques acceptées (même les idées concernant ce que j'ai nommé l'harmonisation cad les noms des propriétés, classes et variables)

[SergioMaster]

Précision au runtime les éléments ne semblent sont pas définis.
Tout vient certainement de la procédure create (les deux dernières lignes)

Code :

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

1
2
3
4
5
6
constructor TFMXRadioGroupBox.Create(AOwner: TComponent);
begin
  ...
  if not Assigned(Frbitems) then FrbItems:=TBoutonsRadio.Create(Self);
  if rbItems.Count>0 then Paint;
end;

dans mon dfm, rbitems est bien fourni

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
  object FMXRadioGroupBox1: TFMXRadioGroupBox
    Padding.Left = 3.000000000000000000
    Padding.Top = 20.000000000000000000
    Padding.Right = 3.000000000000000000
    Padding.Bottom = 3.000000000000000000
    Position.X = 32.000000000000000000
    Position.Y = 112.000000000000000000
    Size.Width = 361.000000000000000000
    Size.Height = 73.000000000000000000
    Size.PlatformDefault = False
    Text = 'FMXRadioGroupBox1'
    TabOrder = 27
    rbItems = <
      item
        ItemTexte = 'Item 0'
        ItemValeur = '0'
      end
      item
        ItemTexte = 'Item 1'
        ItemValeur = '1'
      end
      item
        ItemTexte = 'Item 2'
        ItemValeur = '2'
      end>
    ItemIndex = -1
    Columns = 3
  end

mon problème c'est que je ne sais pas comment le restituer puisque, quand je crée la propriété, à cause de property rbItems : TBoutonsRadio read FrbItems write SetrbItems;rbItems est réinitialisé

Quelqu'un aurait-il en tête un composant standard qui aurait ce même genre de propriété et dans lequel je pourrais puiser mon inspiration ?

[exoseven]

je pense que tu dois redéfinir Loaded c'est à ce moment là que ton composant est chargé avec le contenu du dfm

voir ici par exemple

[SergioMaster]

Merci, je ne connaissais pas cette procédure Loaded
J'ai plus qu'à (enfin ce n'est pas aussi simple que ça je le crains) coder ça. Le seul test rapide que je viens de faire en debug sur la ligne

Code :

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

1
2
3
4
5
6
 
procedure TFMXRadioGroupBox.Loaded;
begin
  inherited;
  FRbItems.Assign(rbItems);
end;

me permet d'affirmer que rbItems contient quelque chose à ce moment là.
Donc ça avance

[SergioMaster]

Bilan après le gap 12h-14h qui m'a permis de m'y pencher un peu plus :
Du mieux mais c'est pas encore gagné

je crains qu'il n'ait encore à travailler la liaison automatique (prochain test, une liaison manuelle pour voir)

Le plus dingue de l'histoire c'est que je n'ai rien codé dans la procédure Loaded

Code :

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

1
2
3
4
procedure TFMXRadioGroupBox.Loaded;
begin
  inherited;
end;

par contre dans ma procédure OnCreate

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
 
constructor TFMXRadioGroupBox.Create(AOwner: TComponent);
begin
  inherited;
  FItemIndex:=-1;
  FItemValue:='';
  FColumns:=1;
  Width:=200;
  Padding.Top:=20;
  Padding.Left:=3;
  Padding.Bottom:=3;
  Padding.Right:=3;
  if Not Assigned(CLayout) then
    begin
     CLayout:=TGridLayout.Create(Self);
     CLayout.Parent:=Self;
     CLayout.Align:=TAlignLayout.Client;
     CLayout.Stored:=False;
    end;
  if not (csLoading in ComponentState) then FrbItems:=TBoutonsRadio.Create(Self);