Bind sur une combobox en programmation object

Version imprimable

Bonjour,

Ça fait quelque temps que je me casse les dents sur une problématique très simple.
Je suis tenté par les liveBidnings, apportant à mon sens l'abstraction qu'il faut pour développer en N'tiers.

Néanmoins je suis sur un cas plutôt basic, j'ai 2 classes (normalement chargées par BDD). Une classe produit et une classe catégorie.
Je veux afficher la liste des catégories et là ça se complexifie pour avoir l'item sélectionné.
Voici le code

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
 
unit Unit5;
 
 
interface
 
 
uses
    System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
    FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, Generics.Collections,
    FMX.Edit, FMX.ListBox, FMX.Controls.Presentation, FMX.StdCtrls,
    Data.Bind.Components, Data.Bind.ObjectScope, Data.Bind.GenData,
    FMX.Bind.Editors, System.Rtti, System.Bindings.Outputs,
    Data.Bind.EngExt, FMX.Bind.DBEngExt;
 
 
type
    TCategory = class
    private
        FName     : String;
        FShortName: String;
        FID       : integer;
    public
        constructor Create(IDFromDataBase: integer; NameFromDataBase: string);
        property ID: integer read FID write FID;
        property Name: String read FName write FName;
    end;
 
 
    TProduct = class
    private
        FID      : integer;
        FName    : string;
        FCategory: TCategory;
    public
        constructor Create(IDFromDataBase: integer; NameFromDataBase: string; Cat: TCategory);
        property ID: integer read FID write FID;
        property Name: string read FName write FName;
        property Category: TCategory read FCategory write FCategory;
    end;
 
 
    TForm5 = class(TForm)
        Label1: TLabel;
        Category: TLabel;
        ComboProductCategory: TComboBox;
        EditProductName: TEdit;
        PrototypeBindSourceCategory: TPrototypeBindSource;
        PrototypeBindSourceProduct: TPrototypeBindSource;
        procedure FormCreate(Sender: TObject);
        procedure PrototypeBindSourceProductCreateAdapter(Sender: TObject; var ABindSourceAdapter: TBindSourceAdapter);
        procedure PrototypeBindSourceCategoryCreateAdapter(Sender: TObject; var ABindSourceAdapter: TBindSourceAdapter);
    private
        { Déclarations privées }
        FListCategory: TObjectList<TCategory>;
        FProduct     : TProduct;
    public
        { Déclarations publiques }
        constructor Create(AOwner: TComponent); override;
 
 
    end;
 
 
var
    Form5: TForm5;
 
 
implementation
 
 
{$R *.fmx}
{ TCategory }
 
 
constructor TCategory.Create(IDFromDataBase: integer; NameFromDataBase: string);
begin
    inherited Create;
    FID   := IDFromDataBase;
    FName := NameFromDataBase;
end;
 
 
{ TProduct }
 
 
constructor TProduct.Create(IDFromDataBase: integer; NameFromDataBase: string; Cat: TCategory);
begin
    inherited Create;
    FID       := IDFromDataBase;
    FName     := NameFromDataBase;
    FCategory := Cat;
end;
 
 
constructor TForm5.Create(AOwner: TComponent);
begin
    FListCategory := TObjectList<TCategory>.Create();
    // Normaly load by query on database
    FListCategory.Add(TCategory.Create(1, 'Clothe'));
    FListCategory.Add(TCategory.Create(2, 'Luxury'));
 
 
    FProduct := TProduct.Create(1, 'Clock', FListCategory.Items[1]);
 
 
    inherited Create(AOwner);
end;
 
 
procedure TForm5.FormCreate(Sender: TObject);
var
    // Bind sur un TEdit
    LinkControl: TLinkControlToField;
    ListLink   : TLinkFillControlToField;
begin
    PrototypeBindSourceProduct.Active  := false;
    PrototypeBindSourceCategory.Active := false;
 
 
    try
        // Bind product name on edit.
        LinkControl            := TLinkControlToField.Create(self);
        LinkControl.DataSource := PrototypeBindSourceProduct;
        LinkControl.FieldName  := 'Name';
        LinkControl.Control    := EditProductName;
        LinkControl.Track      := true;
 
 
        // Bind combo.
        ListLink                      := TLinkFillControlToField.Create(self);
        ListLink.DataSource           := PrototypeBindSourceProduct;
        ListLink.FieldName            := 'Category.ID';
        ListLink.Control              := ComboProductCategory;
        ListLink.FillDataSource       := PrototypeBindSourceCategory;
        ListLink.FillValueFieldName   := 'ID';
        ListLink.FillDisplayFieldName := 'Name';
        ListLink.AutoFill             := true;
        ListLink.Track                := true;
    finally
        PrototypeBindSourceCategory.Active := true;
        PrototypeBindSourceProduct.Active  := true;
    end;
end;
 
 
procedure TForm5.PrototypeBindSourceCategoryCreateAdapter(Sender: TObject; var ABindSourceAdapter: TBindSourceAdapter);
begin
    ABindSourceAdapter := TListBindSourceAdapter<TCategory>.Create(self, FListCategory);
end;
 
 
procedure TForm5.PrototypeBindSourceProductCreateAdapter(Sender: TObject; var ABindSourceAdapter: TBindSourceAdapter);
begin
    ABindSourceAdapter := TObjectBindSourceAdapter<TProduct>.Create(self, FProduct);
end;
 
 
end.

La combo se charge bien, mais je n'ai pas l'item sélectionné.
Le problème vient de là ;

Code:

ListLink.FieldName := 'Category.ID';

Mais je ne vois pas une solution simple pour éviter ceci.
De plus je ne suis pas fan du fait j'ajouté une property "CategoryID" directement sur la classe "Product"

Avez-vous une solution pour ce cas qui parait sur le papier très basique.

PS : je suis en Delphi 10.1 Berlin

Bonjour,

je ne suis pas un pro de la création au runtime des liens toutefois, pour le combo, il me semble qu'il manque une expression de format (format expression) et une expression de résolution (parse expression) voir le post que j'ai pu faire ici notamment la partie "SOLUTION SANS CODE".

Oui, c'était en FMX mais pour les LiveBindings cela importe peu. Actuellement je ne touche plus au FMX (trop de boulot) et donc peu ou pas au LiveBindings car en VCL cela me parait peu pratique.

:arf: Ce qui me rend dingue avec les livebindings c'est qu'il est difficile de maintenir ça correctement avec l'éditeur proposé
en ouvrant une fiche en mode texte on arrive à y voir un peu plus clair mais guère !
pour un équivalent DBcombobox voici ce que cela donne (j'ai mis en rouge ce qu'il faut réussir à avoir)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 object BindLinkContactGenre: TBindLink Category = 'Liens' SourceMemberName = 'GENRE' ControlComponent = ContactGenre SourceComponent = BindSourceContacts ParseExpressions = < item ControlExpression = 'ItemIndex' SourceExpression = 'Value' end> FormatExpressions = < item ControlExpression = 'ItemIndex' SourceExpression = 'Value' end> ClearExpressions = <> Track = False end
en espérant que ça aide

SourceMemberName c'est ListLink.FieldName lorsque l'on regarde loin dans les sources de TLinkControlToFieldDelegate
et GetFieldValueMemberNames il faut que regarde si SupportsNestedFields est à True comme dans TListBindSourceAdapter<T> ou TObjectBindSourceAdapter<T> pour que TBindSourceAdapter.FindField gère le '.' pour gérer le Path.FieldName

c'est PrototypeBindSourceProduct qui doit supporter SupportsNestedFields via un Adapter

EDIT : En théorie

PrototypeBindSourceProduct.DataGenerator.SupportsNestedFields est à False car il inhibe celui hérité de TListBindSourceAdapter
C'est tordu le code des LiveBindingds !
le problème c'est que sur un TPrototypeBindSource tu ne peux pas lui fournir un autre DataGenerator
Il faudra héritéer TPrototypeBindSource et redéfinir GetInternalAdapter qui renvoie une version héritée TCustomDataGeneratorAdapter avec SupportsNestedFields redéfini à True,
par contre comment connecté ensuite le DataGenerator et le InternalAdapter ? j'ai peur qu'il faut faire une classe proxy qui implémentent toutes les méthodes du InternalAdapter sauf SupportsNestedFields

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
 
  TPrototypeBindSource = class(Data.Bind.ObjectScope.TBaseObjectBindSource)
  private
    FDataGenerator: TCustomDataGeneratorAdapter;
    FAdapter: TBindSourceAdapter;
    function GetFieldDefs: TGeneratorFieldDefs;
    function GetRecordCount: Integer;
    procedure SetFieldDefs(const Value: TGeneratorFieldDefs);
    procedure SetRecordCount(const Value: Integer);
    procedure SetAutoEdit(const Value: Boolean);
    procedure SetAutoPost(const Value: Boolean);
    function GetAutoEdit: Boolean;
    function GetAutoPost: Boolean;
  protected
    function GetInternalAdapter: TBindSourceAdapter; override;
  public
    constructor Create(AOwner: TComponent); override;
    [Default(true)]
    property AutoEdit: Boolean read GetAutoEdit write SetAutoEdit default true;
    property AutoPost: Boolean read GetAutoPost write SetAutoPost;
    property FieldDefs: TGeneratorFieldDefs read GetFieldDefs write SetFieldDefs;
    [Default(-1)]
    property RecordCount: Integer read GetRecordCount write SetRecordCount default -1;
    property DataGenerator: TCustomDataGeneratorAdapter read FDataGenerator;
  end;
 
  TCustomDataGeneratorAdapterEx = class(TCustomDataGeneratorAdapter)
  protected
    function SupportsNestedFields: Boolean; override;
  end;
 
TForm5 = class(TForm)
        Label1: TLabel;
        Category: TLabel;
        ComboProductCategory: TComboBox;
        EditProductName: TEdit;
        PrototypeBindSourceCategory: TPrototypeBindSource;
        PrototypeBindSourceProduct: TPrototypeBindSource;
...
 
implementation
 
{ TPrototypeBindSource }
 
 
 
function TPrototypeBindSource.GetAutoEdit: Boolean;
begin
  Result := FDataGenerator.AutoEdit;
end;
 
function TPrototypeBindSource.GetAutoPost: Boolean;
begin
  Result := FDataGenerator.AutoPost;
end;
 
function TPrototypeBindSource.GetFieldDefs: TGeneratorFieldDefs;
begin
  Result := FDataGenerator.FieldDefs;
end;
 
function TPrototypeBindSource.GetInternalAdapter: TBindSourceAdapter;
begin
  if CheckRuntimeAdapter then
    Result := GetRuntimeAdapter
  else if FAdapter <> nil then
    Result := FAdapter
  else
    Result := FDataGenerator;
  if (Result <> nil) and (not (csDestroying in Result.ComponentState)) then
  begin
    ConnectAdapter(Result);
  end;
end;
 
function TPrototypeBindSource.GetRecordCount: Integer;
begin
  Result := FDataGenerator.RecordCount;
end;
 
procedure TPrototypeBindSource.SetAutoEdit(const Value: Boolean);
begin
  FDataGenerator.AutoEdit := Value;
end;
 
procedure TPrototypeBindSource.SetAutoPost(const Value: Boolean);
begin
  FDataGenerator.AutoPost := Value;
end;
 
procedure TPrototypeBindSource.SetFieldDefs(
  const Value: TGeneratorFieldDefs);
begin
  FDataGenerator.FieldDefs := Value;
end;
 
procedure TPrototypeBindSource.SetRecordCount(const Value: Integer);
begin
  FDataGenerator.RecordCount := Value;
end;
 
constructor TPrototypeBindSource.Create(AOwner: TComponent);
begin
  inherited;
  FAutoEdit := True;
  FDataGenerator := TCustomDataGeneratorAdapterEx.Create(Self); // No free needed, Owned by Self
end;
 
 
function TCustomDataGeneratorAdapter.SupportsNestedFields: Boolean;
begin
  Result := True; // Et voir ci ça fonctionne car il y a peut-être le FindField a modifié pour gérer le Path
end;

Personnellement, j'ai aussi pratiqué les objets imbriqués et je ne fais quasiment plus préférant "CategoryID" surtout que j'ai d'ailleurs de la sérialisation et un marshalling qui s'occupe de sauvegarder le fichier en DB

En partant de vos pistes j'ai creuser un peu dans les sources.
A priori le "SupportsNestedFields" est bien a true.

La méthode "function TBindSourceAdapter.FindField(const AMemberName: string): TBindSourceAdapterField;" trouve bien mon champ, comprend que c'est une classe et pas un scalaire.
Par contre je rentre dans cette partie de code
Code:

1 2 3 4 5 6 7 8 for LField in FFields do begin if SameText(LField.MemberName, LFieldName) then begin if LPath <> '' then Exit(LField.FindField(LPath)); Exit(LField); end; end;
Mais le "LField.FindField(LPath)" retourne nil 8O
Code:

1 2 3 function TBindSourceAdapterField.FindField(const AMemberName: string): TBindSourceAdapterField;begin Result := nil; end;
Du coup il faut peut-être réussir à dériver le TBindSourceAdapterField pour un créer un particulier :?