Blog de Serge Girard (aka SergioMaster)

Ce billet sera le dernier de la série avant de refermer ce carnet. Cette fois-ci je m'attaque à la liaison entre un TPrototypeBindSource et le TControlList.

Pour ceux qui ne sont pas habitués, un TPrototypeBindSource permet de créer un ensemble de données qui contiendra des valeurs aléatoires, en fonction des types colonnes souhaitées. Pratique pour un design rapide d'interface, inutile dans une application réelle si ce n'est qu'une simple instruction fera basculer cet ensemble de données aléatoires en chargeant une liste de vos propres objets et valeurs.

Pourquoi, alors, n'ai-je point commencé par là au lieu d'utiliser le fichier biolife.cds ? De fait, lors de la sortie de la version 10.4, fort de mon expérience FMX, j'ai commencé par ça et ait été totalement déçu par le comportement de TControlList. De mon point de vue, le scénario à éviter pour une première démonstration est bien ce type d'association ! Plusieurs bogues et manques se révèlent très vite, en partie dû à la liaison entre les deux composants via l'utilisation de LiveBindings.

Commençons par quelque chose de simple avant de nous mettre dans les eaux troubles.



Ce premier programme, que vous pourrez retrouver dans mon dépôt GitHub, est largement inspiré d'une démonstration de Jim McKeeth trouvée ici.
Question remplissage de la liste, je n'ai pas tout à fait suivi le même schéma, en effet Jim récupère le nom de la couleur affichée.

Code :

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

ACanvas.Brush.Color := StrToInt(lblColorValue.Caption);

De mon côté, j'ai préféré récupérer directement la valeur de la couleur générée

Code :

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

ACanvas.Brush.Color := Couleurs.DataGenerator.FindField('Color1').GetTValue.AsInteger;

Petite cerise sur le gâteau, j'ai également géré la couleur de fonte des libellés

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
procedure TFormCouleurs.ControlList1BeforeDrawItem(AIndex: Integer;
  ACanvas: TCanvas; ARect: TRect; AState: TOwnerDrawState);
var
  FontColor: TColor;

  function IsDark(AColor: TColor): Boolean;
  // Paul Toth
  var
    Color: Integer;
  begin
    Color := ColorToRGB(AColor); // conversion clXXX en couleur RGB
    Result := 0.2125 * TColorRec(Color).R + 0.7174 * TColorRec(Color).G + 0.0721
      * TColorRec(Color).B <= 128;
  end;

begin
  ACanvas.Brush.Color := Couleurs.DataGenerator.FindField('Color1').GetTValue.AsInteger;
  ACanvas.FillRect(ARect);

  if IsDark(ACanvas.Brush.Color) then
    FontColor := clWhite
  else
    FontColor := clBlack;
  LblCouleur.Font.Color := FontColor;
  LblItem.Font.Color := FontColor;
  LblItem.Caption := Format('Item n°%d', [AIndex]);
end;

Si, a priori, il semble fonctionner correctement cela gêne aux entournures.



Regardez dans le cadre rouge les valeurs liées ne sont pas les valeurs de l'élément sélectionné, mais celle du dernier élément dessiné visible dans la liste !

Comment s'en sortir ? Tout d'abord en n'associant pas les données via Livebindings puis en utilisant l'évènement OnAfterDrawItems pour :

• Me positionner dans le TPrototypeBindSource (que j'ai nommé couleurs).
• Renseigner par code les deux zones.

Code :

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

1
2
3
4
5
6
7
8
9
procedure TFormCouleurs.ControlList1AfterDrawItems(ACanvas: TCanvas;
  ARect: TRect);
begin
  // positionnement dans "fichier"
  Couleurs.ItemIndex := ControlList1.ItemIndex;
  // écriture des valeurs
  Couleur.Brush.Color := Couleurs.DataGenerator.FindField('Color1').GetTValue.AsInteger;
  NomCouleur.Caption := Couleurs.DataGenerator.FindField('ColorsName1').GetTValue.AsString;
end;

Pour être sûr de mon fait, j'ai ajouté un TNumberBox qui permet de visualiser le numéro de l'élément en cours, mais aussi de se déplacer au sein de la liste (toujours grâce aux Livebindings)

Code :

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

1
2
3
4
5
6
7
8
9
procedure TFormCouleurs.ControlList1ItemClick(Sender: TObject);
begin
  NumberBox1.Value := ControlList1.ItemIndex;
end;

procedure TFormCouleurs.FormCreate(Sender: TObject);
begin
  NumberBox1.MaxValue := ControlList1.ItemCount - 1;
end;

Maintenant qu'un moyen de résoudre le problème est possible, il ne s'agit pas de rester sur un truc qui reste malgré tout très théorique, mais plutôt de démontrer qu'il est possible de remplir un TControlList avec notre propre liste d'objets. Je vais partir sur une sorte de trombinoscope pour pouvoir mêler images et libellés (un nom et une date).

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
unit UCtrlListContacts;

interface

uses System.SysUtils
  // nécessaire pour obtenir la date système, le type TFileName
    , System.Generics.Collections
  // nécessaire pour la déclaration de liste d'objets
    , System.Generics.Defaults, System.Classes, System.types,
  System.NetEncoding, System.DateUtils // nécessaire pour EncodeDate
    , VCL.graphics, VCL.Imaging.pngimage, System.UITypes;
type
  TContact = Class
  strict private
    FNom: String;
    FDate: String;
    FPhoto: TPicture;
  private
    // ...
    procedure SetNom(const Value: String);
    procedure SetDate(const Value: String);
    procedure SetPhoto(const Value: TPicture);
  public
    constructor Create(); overload;
    constructor Create(Nom: String; UneDate: String; Photo: TPicture); overload;
    property ContactNom: String read FNom write SetNom;
    property ContactDate: String read FDate write SetDate;
    property ContactPhoto: TPicture read FPhoto write SetPhoto;
  end;

// ..
var
  MesContacts: TObjectList<TContact>;

implementation
//...
initialization
   MesContacts := TObjectList<TContact>.Create;

L'astuce pour construire la forme est de déposer un TProtypeBindSource sur celle-ci avec "la même structure" que la classe TContact. Par même structure, il faut surtout comprendre même noms de colonnes et type.



À nouveau un peu de turbidité s'élève du fond : le générateur ContactBitmaps ne fonctionne pas correctement (une seule image est rendue dans la liste). J'ai tout d'abord incriminé le TControlList mais en fait il s'agit bien d'un problème de générateur, étrangement ce générateur n'est pas déclaré dans l'unité Data.Bind.GenData (alors qu'il est proposé). Je n'ai pas ou déterminer d'où pouvait bien provenir l'image (en FMX, le générateur et ces images sont déclarées dans FMX.Bind.GenData). Cela n'a aucune importance mais... En VCL, oublier les générateurs du TPrototypeBindSource ContactBimaps et ContactBitmapsL et en rester à Bitmaps est donc une idée à garder en mémoire pour éviter ce petit désagrément.

Il ne me reste plus qu'à mettre en place l'utilisation de la collection.

Code :

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

1
2
3
4
5
6
7
procedure TForm14.ContactsCreateAdapter(Sender: TObject;
  var ABindSourceAdapter: TBindSourceAdapter);
begin
 P_DonneesInternes; // charge les données, fonction de classe
 ABindSourceAdapter:=TListBindSourceAdapter<TContact>.Create(self,MesContacts, True);  // remplace les données du TPrototypeBindSource
 ControlList1.ItemCount:=MesContacts.Count;  // Nombre d'élément dans la liste
end;

Puis appliquer la solution exposée plus haut

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
procedure TForm14.ControlList1AfterDrawItems(ACanvas: TCanvas; ARect: TRect);
var aStream : TMemoryStream;
    avar : TPicture;
begin
if  Contacts.ItemIndex<>ControlList1.ItemIndex then Contacts.ItemIndex:=ControlList1.ItemIndex;
Nom.Text:=MesContacts[ControlList1.ItemIndex].ContactNom;
DateC.Date:=StrToDate(MesContacts[ControlList1.ItemIndex].ContactDate);
// partie chargement image
aStream:=TmemoryStream.Create;
try
    avar:=MesContacts[ControlList1.ItemIndex].ContactPhoto;
    if assigned(avar) then
     begin
      avar.savetostream(astream);
      aStream.Position:=0;
      Photo.Picture.LoadFromStream(aStream);
     end;
finally
  aStream.Free;
end;

Vous retrouverez dans mon dépôt github le source du programme et ma solution de sauvegarde/chargement des données. N.B. je n'ai pas géré les ajouts et suppressions, cela fera peut-être lieu à une mise à jour dans le futur.

Quels enseignements tirés de cette partie :
Le composant TControlList est bogué s'il est en liaison avec un TProtypeBindSource, néanmoins il est utilisable une fois cette mise en garde connue.