|
Génériques Delphi - John COLIBRI. |
- résumé : les Génériques Delphi : exemple avec une tList<T>, création d'une pile, règles de compatibilité de type, génération du code, types pouvant être génériques, contraintes Interface, Class, héritage,
Constructor. Exemple Observateur, Factory et Calculateur. Interfaces et conteneurs génériques de la Vcl
- mots clé : type paramétré, paramètre actuel, surtypage, méthodes
génériques, Design Pattern Observer, RTTI, constructeur virtuel, non rooted data types, iComparer, iEqualityComparer, tEnumerator, tEnumerable
- logiciel utilisé : Windows XP personnel, Delphi Xe2
- matériel utilisé : Pentium 2.800 Mhz, 512 Meg de mémoire, 250 Giga disque dur
- champ d'application : Delphi 2009 et supérieur
- niveau : développeur Delphi
- plan :
1 - Delphi Generics Les types génériques Delphi, aussi appelés types paramétrés, permettent
d'utiliser des Classes pour lesquelles un ou plusieurs types ne sont pas spécifiés à la définition du type, mais seulement au moment de l'utilisation de la Classe.
Par exemple, nous pouvons utiliser une Classe tList<T> où "T" est un paramètre, et lorsque nous aurons besoin d'une liste d'entiers ou de réels, nous créerons des objets qui spécifient quel type précis nous souhaitons utiliser
Var my_integer_list: tList<Integer>;
my_string_list: tList<Double>;
|
Ces types génériques
- évitent d'avoir à écrire des versions différentes de chaque conteneur, une pour des liste contenant des Integer, une pour des Double
- évitent bien souvent les surtypages. Nous pouvons utiliser une
tList<c_person> et la cellule ma_liste[3] est du type c_person:
Var my_person_list: tList<c_person>;
my_person_list[3].m_age:= 18;
|
Nous pouvons utiliser des génériques dans nos applications de deux façons:
- soit utiliser la librairie de conteneurs génériques Delphi, tList<T>, tQueue<T> etc
- soit créer nos propres classes génériques
Exactement comme pour les objets, nous pouvons
- soit utiliser les objets de la librairie Delphi (les tButton, tPen, tObjectList)
- soit créer nos propres types génériques
Nous allons
- commencer par présenter les génériques en utilisant une tList<T> pour assoir la syntaxe et la terminologie
- entrer plus dans le détail de création de nos propres génériques
2 - tLists<T> 2.1 - Une liste de c_person Nous allons utiliser une liste de personnes, chaque personne étant définie par une Classe :
Type c_person=
Class
m_first_name: String;
m_age: integer;
Constructor create_person(
p_first_name: String; p_age: Integer);
Function f_c_self: c_person;
Function ToString: String; Override;
End; // c_person
|
Nous pouvons créer une liste de c_person en utilisant un conteneur Delphi quelconque (tList, tObjectList, tStringList, tCollection), mais pour accéder à un élément de la liste nous devons utiliser le surtypage:
Var g_c_person_list: tList= Nil;
Procedure TForm1.c_person__tlist_Click(Sender: TObject);
Var l_c_person: c_person;
Begin
g_c_person_list:= tList.Create;
g_c_person_list.Add(c_person.create_person('mike', 24));
g_c_person_list.Add(c_person.create_person('anna', 18));
l_c_person:= c_person(g_c_person_list[1]); // <=== casting
display(l_c_person.ToString);
End; // c_person__tlist_Click
|
La solution est en général d'encapsuler la liste dans une Classe qui devra
aussi utiliser le casting, mais au moins ce surtypage sera encapsulé dans une Classe, et en général dans une unité de gestion de personne, pour éviter de surtyper dans les programmes utilisateurs :
Unit u_c_non_generic_person_list;
Interface
Uses Classes, u_c_person;
Type c_person_list=
Class(tList)
Constructor create_person_list;
Function f_c_person(p_person_index: Integer): c_person;
Procedure display_person_list;
Destructor Destroy; Override;
End; // c_person
Implementation
Uses SysUtils, u_display_simple;
// -- c_person_list
Constructor c_person_list.create_person_list;
Begin
Inherited create;
End; // create_person_line
Function c_person_list.f_c_person(p_person_index: Integer): c_person;
Begin
Result:= c_person(Items[p_person_index]); // <=== casting
End; // f_c_person
Procedure c_person_list.display_person_list;
Var l_person_index: Integer;
Begin
For l_person_index:= 0 To Count- 1 Do
With f_c_person(l_person_index) Do
display(ToString);
End; // display_person_list
Destructor c_person_list.Destroy;
Var l_person_index: Integer;
Begin
For l_person_index:= 0 To Count- 1 Do
f_c_person(l_person_index).Free;
Inherited;
End; // Destroy
End. // u_c_person
|
Le problème se pose aussi si nous souhaitons écrire un conteneur qui puisse
contenir plusieurs types différents : des Integer, des String, des c_person: dès que nous souhaitons effectuer des opérations sur les éléments (comparaison,
opérations arithmétiques, sauvegarde), comme le compilateur ne peut pas générer du code qui soit applicable à ces types différents, nous devons écrire des Classes séparées pour chaque type de cellule.
2.2 - Utilisation de tList<T> Pour résoudre ce type de problème, Delphi propose, depuis Delphi 2009, les types générique. Voici le même exemple en utilisant la classe conteneur tList<T>:
- le type est défini dans l'unité Generics.Collections
- nous déclarons une variable qui va contenir notre liste de personnes ;
Var g_c_generic_person_list: tList<c_person>;
|
- nous créons la list en appelant Create
g_c_generic_person_list:= tList<c_person>.Create;
|
- nous ajoutons des personnes:
g_c_generic_person_list.Add(c_person.create_person('mike', 24));
|
- et nous récupérons une personne de la liste en précisant son index. Mais à présent, la cellule de tList<c_person> est bien du type c_person (aucun surtypage n'est utilisé)
Var l_c_person: c_person;
l_c_person:= g_c_generic_person_list[1];
|
Voici le code complet:
Uses Generics.Collections;
Var g_c_generic_person_list: tList<c_person>= Nil;
Procedure TForm1.generic_person_list_Click(Sender: TObject);
Var l_c_person: c_person;
Begin
g_c_generic_person_list:= tList<c_person>.Create;
g_c_generic_person_list.Add(c_person.create_person('mike', 24));
g_c_generic_person_list.Add(c_person.create_person('anna', 18));
l_c_person:= g_c_generic_person_list[1];
display(l_c_person.ToString);
g_c_generic_person_list.Free;
End; // generic_person_list_Click
|
Notez que - lors de la création, nous devons répéter "c_person" (alors que g_c_generic_person_list a déjà été déclaré comme une tList<c_person>.
g_c_generic_person_list:= tList<c_person>.Create;
|
En effet, nous pourrions dans le même programme invoquer Create pour plusieurs listes:
tList.Create
tList<c_person>.Create;
tList<Integer>.Create
| et pour effectuer ses vérifications, le compilateur a besoin de savoir quel
type exactement nous souhaitons utiliser
2.3 - Terminologie Un peu de terminologie: Au niveau de la définition du type - tList<T> est un "type générique" ou "type paramétré"
- T est le "paramètre de type"
- le paramètre de type peut être noté
- soit par une lettre: T comme Type
- soit par un identificateur plus significatif
| tDictionary<tKey, tValue> | ou
- il peut y avoir plusieurs paramètres, comme le montre l'exemple du
dictionnaire ci-dessus
Au niveau de l'utilisation
3 - Création de Types Paramétrés 3.1 - Une pile générique simple Voici une Classe qui implémente un pile générique: - le type est défini par:
Type c_generic_stack<T>=
Class
m_gen_array: Array Of T;
m_top_of_stack: Integer;
Constructor create_generic_stack(p_length: Integer);
Procedure push(p_gen: T);
Function f_pop: T;
End; // c_generic_stack
| - et cette classe est implémentée ainsi;
Constructor c_generic_stack<T>.create_generic_stack(p_length: Integer);
Begin
Inherited Create;
SetLength(m_gen_array, p_length);
End; // create_generic_stack
Procedure c_generic_stack<T>.push(p_gen: T);
Begin
If m_top_of_stack= Length(m_gen_array)
Then SetLength(m_gen_array, 2* Length(m_gen_array));
If m_top_of_stack< Length(m_gen_array)
Then Begin
m_gen_array[m_top_of_stack]:= p_gen;
Inc(m_top_of_stack);
End;
End; // push
Function c_generic_stack<T>.f_pop: T;
Begin
If m_top_of_stack>= 0
Then Begin
Dec(m_top_of_stack);
Result:= m_gen_array[m_top_of_stack];
End
Else raise Exception.Create('empty') ;
End; // f_pop
|
Notez que
L'utilisation se fait exactement comme pour la tList<T> :
Var g_c_generic_stack: c_generic_stack<Integer>= Nil;
Procedure TForm1.generic_integer_stack_Click(Sender: TObject);
Begin
g_c_generic_stack:= c_generic_stack<Integer>.create_generic_stack(4);
g_c_generic_stack.push(111);
g_c_generic_stack.push(222);
g_c_generic_stack.push(333);
display(IntToStr(g_c_generic_stack.f_pop));
display(IntToStr(g_c_generic_stack.f_pop));
display(IntToStr(g_c_generic_stack.f_pop));
End; // generic_integer_stack_Click
|
Et
- comme précédemment, pour créer l'objet nous avons du répéter le type actuel ayant le nom du constructor
Var g_c_generic_stack: c_generic_stack<Integer>;
g_c_generic_stack:= c_generic_stack<Integer>.create_generic_stack(4);
|
- le type c_stack<Integer> (ou c_stack<String>, c_stack<Double> etc) pourra être utilisé partout où un tList pouvait être utilisé
- comme paramètre (valeur, VAR, CONST) de procédure, fonction ou méthode
- comme résultat de fonction
- comme attribut d'une autre Classe
- comme ancêtre d'une autre Classe
Voici quelques exemples :
Var g_array_of_integer_stack: Array[1..5] Of c_generic_stack<Integer>;
g_person_history: Record
m_age: Integer;
m_c_task_stack: c_generic_stack<Integer>;
End;
Procedure compute_stack_average(p_c_integer_stack: c_generic_stack<Integer>);
Begin
End;
Type c_display_integer_stack=
Class(c_generic_stack<Integer>)
End; // c_display_integer_stack
|
Le type c_generic_stack<T> pourrait être utilisé - n'importe où (comme in Integer) dans un type paramétré par T
Type c_structure<T>=
Class
m_c_stack: c_generic_stack<T>;
End; // c_structure<T>
c_dictionary<Key, T>=
Class
m_c_stack: c_generic_stack<T>;
End; // c_dictionary<Key, T>
|
- nous pouvons aussi hériter de c_generic_stack<T>
Type c_generic_buffered_stack<T>=
Class(c_generic_stack<T>)
End; // c_generic_buffered_stack<T>
|
3.2 - Compatibilité de type Un des objectifs des types génériques est de permettre l'écriture de librairies générales sans avoir à surtyper en permanence. Le compilateur est donc particulièrement attentif à verifier que les types sont
correctement utilisés. Sont ainsi signalés comme erreur à la compilation - les affectations entre éléments de deux types différents.
Avec les déclarations suivantes:
Var g_c_integer_list: tList<Integer>;
g_c_char_list: tList<Char>;
g_char: Char;
| sont refusés:
g_char:= g_c_generic_stack.f_pop;
g_c_integer_list[2]:= g_c_char_list[1];
|
- les règles de substitution d'un type descendant à un type ancêtre sont, comme escompté, permises (Liskov substitution principle, LSP pour les intimes)
Type c_generic_buffered_stack<T>=
Class(c_generic_stack<T>)
End;
c_display_integer_stack=
Class(c_generic_stack<Integer>)
End; // c_display_integer_stack
Var g_c_generic_buffered_stack: c_generic_buffered_stack<Integer>;
g_c_display_integer_stack: c_display_integer_stack;
g_c_generic_stack:= g_c_generic_buffered_stack;
g_c_generic_stack:= g_c_display_integer_stack;
| - Delphi a même assoupli ses règles de "compatibilité par nom de type" :
normalement, deux variables sont compatibles si leur nom de type est le même. Sera ainsi refusé :
Var g_array_1: Array[1..5] Of Integer;
g_array_2: Array[1..5] Of Integer;
g_array_1:= g_array_2;
| alors que ceci est accepté (les variables utilisent le même NOM de type):
Type t_array_of_five_integer= Array[1..5] Of Integer;
Var g_array_5_1: t_array_of_five_integer;
g_array_5_2: t_array_of_five_integer;
g_array_5_1:= g_array_5_2;
|
Mais pour les génériques :
Type t_integer_list= tList<Integer>;
Var g_integer_list_1: t_integer_list;
g_integer_list_2: tList<Integer>;
g_integer_list_3: tList<Integer>;
g_integer_list_1:= g_integer_list_2;
g_integer_list_3:= g_integer_list_2;
|
- les conteneurs génériques et leur version non générique ne sont pas compatibles entre eux (mais les types actuels, par exemple Integer, le sont, naturellement)
Var g_pointer_list: tList<Pointer>;
g_list: tList;
g_c_pointer_list:= g_c_list;
|
4 - Implémentation des Génériques Lorsque le compilateur rencontre un type paramétré, il génère un code
définissant ce type (des attributs spécifiques dans les tables du compilateur et une sorte de pseudo-code, à savoir l'arbre syntaxique abstrait pour le code exécutable). Si nos génériques sont dans une unité, le tout est sauvegardé dans
le .DCU pour utilisation lorsque nous déclarerons des variables utilisant ces génériques. Donc la définition du type générique peut être compilée sans qu'un objet avec un paramètre actuel ne soit déclaré.
Lorsque nous déclarons des objets avec des paramètre actuel particulier (Integer, c_person ...), le compilateur génère le code binaire spécifique à chaque paramètre actuel différent. Il recharge l'arbre syntaxique générique et
le spécialise pour le paramètre actuel. Le code exécutable - ne contient donc pas de code assembleur pour la définition générique
- contient autant de code assembleur que de paramètre actuel différent
Cette génération du code actuel, similaire à du code Inline impose quelques restrictions - nos génériques ne peuvent contenir de code Asm
- les appels de méthodes génériques ne peuvent être Inline
Pour tester que différents binaires sont générés, il suffit de tester l'adresse mémoire des méthodes d'une Classe générique :
5 - Qui peut être générique ? 5.1 - Classes génériques Comme nous l'avons vu ci-dessus, les Classes peuvent être génériques
5.2 - Record génériques
Les Record, qui à travers les années ont acquis en Delphi de nombreuses fonctionnalités des Classes (Property, Constructor etc), peuvent aussi être dotées de paramètres
Type t_point<T_coordinate>=
Record
m_x, m_y, m_z: T_coordinate;
End; // t_point
Var g_center: t_point<Integer>;
g_projection: t_point<Double>;
Procedure TForm1.generic_record_Click(Sender: TObject);
Begin
g_center.m_x:= 100;
g_projection.m_x:= 3.1415;
display(IntTostr(g_center.m_x));
display(FloatToStr(g_projection.m_x));
End; // generic_record_Click
|
5.3 - Array génériques
Les cellules d'un tableau peuvent aussi être paramétrées
Type t_array<T_cell>= Array Of T_cell;
t_xy_array<T_coordinate>= Array Of Array Of T_coordinate;
t_average_array<T_value>= Array[1..5] Of T_value;
Var g_counts: t_array<Integer>;
g_measures: t_array<Double>;
g_index: integer;
g_xy_array: t_xy_array<Double>;
g_array_of_double: Array Of Double;
Procedure TForm1.generic_array_Click(Sender: TObject);
Begin
SetLength(g_counts, 100);
For g_index:= 0 To 99 Do
g_counts[g_index]:= Random(100);
SetLength(g_measures, 20);
For g_index:= 0 To 19 Do
g_measures[g_index]:= 3.14* Random;
SetLength(g_xy_array, 10, 20);
g_xy_array[2, 3]:= 3.14;
SetLength(g_array_of_double, 10* 20);
g_array_of_double[2* 10+ 3]:= g_xy_array[2, 3];
End; // generic_array_Click
| Comme indiqué précédemment, un conteneur (tableau) générique n'est pas
compatible globalement avec sa version non générique
Type t_array<T_cell>= Array Of T_cell;
Var g_measures: t_array<Double>;
g_array_of_double: Array Of Double;
g_measures:= g_array_of_double;
|
5.4 - Types procéduraux génériques Voici un type procédural générique :
Type t_gp_handle_two<T>= Procedure(p_one, p_two: T);
| qui peut être utilisé pour des Integer (en utilisant DIV)
Procedure convert_two_integer(p_value, p_rate: Integer);
Begin
display(Format('%4d div %4d = %d ',
[p_value, p_rate, p_value Div p_rate]));
End; // convert_two_integer
Procedure TForm1.convert_integer_Click(Sender: TObject);
Var l_gp_convert_two_integer: t_gp_handle_two<Integer>;
Begin
l_gp_convert_two_integer:= convert_two_integer;
l_gp_convert_two_integer(20, 3);
End; // convert_integer_Click
|
ou des Double (en utilisant /:
Procedure convert_two_double(p_value, p_rate: Double);
Begin
display(Format('%7.2f div %7.2f= %g ',
[p_value, p_rate, p_value / p_rate]));
End; // convert_two_double
Procedure TForm1.convert_double_Click(Sender: TObject);
Var l_gp_convert_two_double: t_gp_handle_two<Double>;
Begin
l_gp_convert_two_double:= convert_two_double;
l_gp_convert_two_double(20.0, 3.0);
End; // convert_double_Click
|
Nous pouvons aussi définir des type fonctionnels génériques, comme celui-ci:
Unit u_c_vector;
Interface
Type t_gf_handle_one<T>= Function(p_value: T): T;
c_vector<T>=
Class
m_vector: Array[0..9] Of T;
Constructor Create;
Procedure compute(p_gf_handle_one: t_gf_handle_one<T> );
End; // c_vector<T>
Implementation
// -- c_vector<T>
Constructor c_vector<T>.Create;
Begin
Inherited;
End; // Create
Procedure c_vector<T>.compute(p_gf_handle_one: t_gf_handle_one<T>);
Var l_index: Integer;
Begin
For l_index:= 0 To 9 Do
m_vector[l_index]:= p_gf_handle_one(m_vector[l_index]);
End;
End.
| qui donne une légère teinte fonctionnelle à nos applications:
Function f_integer_square(p_value: Integer): Integer;
Begin
Result:= p_value* p_value;
End; // f_integer_square
Procedure display_vector(p_c_vector: c_vector<Integer>);
Var l_index: Integer;
l_result: String;
Begin
l_result:= '';
For l_index:= 0 To 9 Do
l_result:= l_result+ IntToStr(p_c_vector.m_vector[l_index])+ ' ';
display(l_result);
End; // display_vector
Procedure TForm1.apply_function_Click(Sender: TObject);
Var l_c_vector: c_vector<Integer>;
l_index: Integer;
Begin
l_c_vector:= c_vector<Integer>.Create;
For l_index:= 0 To 9 Do
l_c_vector.m_vector[l_index]:= l_index;
display_vector(l_c_vector);
l_c_vector.compute(f_integer_square);
display_vector(l_c_vector);
End; // apply_function_Click
|
5.5 - Evénements génériques (PROCEDURE OF OBJET) Les événements sont très similaires aux types procéduraux, mais ne peuvent être utilisés que par des Classes. Le fonctionnement interne est le même, mais le
compilateur pousse simplement un paramètre supplémentaire transparent qui est l'objet qui a appelé la procédure. En outre, des événements sont plus utilisés pour notifier l'utilisateur d'une classe que quelque chose s'est passé que pour
appliquer un traitement. Ils sont en général utilisés comme une sorte de callback (la souris a été cliqué, un caractère est arrivé du réseau, etc). Voici une PROCEDURE OF OBJECT qui va nous informer de tout changement:
Unit u_c_storage;
Interface
Type t_po_notify_change<T>= Procedure(p_value: T) Of Object;
c_storage<V>=
Class
m_table: Array Of V;
m_on_notify_value_changed: t_po_notify_change<V>;
m_on_notify_storage_changed: t_po_notify_change< c_storage<V> >;
Constructor create_storage(p_size: Integer);
Procedure add_value(p_index: Integer; p_value: V);
End; // c_storage
Implementation
// -- Type c_storage<V>
Constructor c_storage<V>.create_storage(p_size: Integer);
Begin
Inherited Create;
SetLength(m_table, p_size);
End; // create_storage
Procedure c_storage<V>.add_value(p_index: Integer; p_value: V);
Begin
m_table[p_index]:= p_value;
If Assigned(m_on_notify_value_changed)
Then m_on_notify_value_changed(p_value);
If Assigned(m_on_notify_storage_changed)
Then m_on_notify_storage_changed(Self);
End; // add_value
End. // u_c_storage
| qui peut être utilisée ainsi:
Type c_statistics=
Class
m_c_storage: c_storage<Integer>;
Constructor create_statistics;
Procedure display_value_changed(p_value: Integer);
Procedure display_storage_changed(p_c_storage: c_storage<Integer>);
End; // c_storage
Constructor c_statistics.create_statistics;
Begin
Inherited Create;
m_c_storage:= c_storage<Integer>.create_storage(5);
m_c_storage.m_on_notify_value_changed:= display_value_changed;
m_c_storage.m_on_notify_storage_changed:= display_storage_changed;
End; // create_statistics
Procedure c_statistics.display_value_changed(p_value: Integer);
Begin
display('added_value '+ IntToStr(p_value));
End; // display_value_changes
Procedure c_statistics.display_storage_changed(p_c_storage: c_storage<Integer>);
Var l_index: Integer;
Begin
display('added_value_to ');
For l_index:= 0 To Length(p_c_storage.m_table)- 1 Do
display(' '+ IntToStr(p_c_storage.m_table[l_index]));
End; // display_storage_changed
Var g_c_statistics: c_statistics;
Procedure TForm1.notify_addition_Click(Sender: TObject);
Begin
g_c_statistics:= c_statistics.create_statistics;
g_c_statistics.m_c_storage.add_value(0, 33);
End; // notify_addition_Click
|
Notez que - au niveau de la définition
- il faut que la classe qui a un événement comme champ ait ell-même un paramètre
- au niveau de l'utilisation
- une PROCEDURE OF OBJECT ne peut être utilisée que dans une Classe.
C'est pourquoi nous avons créé notre Classe c_statistics
- nous aurions aussi pu faire pointer m_on_xxx vers une méthode de notre Forme
5.6 - Méthodes génériques
On peut aussi doter une Classe d'une méthode générique: Type c_sort=
Class
Procedure swap<T>(Var p_one, p_two: T);
End; // c_sort
Procedure c_sort.swap<T>(Var p_one, p_two: T);
Var l_temporary: T;
Begin
l_temporary:= p_one;
p_one:= p_two;
p_two:= l_temporary;
End; // swap<T>
// -- example of use
Procedure TForm1.generic_method_Click(Sender: TObject);
Var l_one, l_two: Double;
Begin
l_one:= 3.14;
l_two:= 20* pi;
display(Format('%5.2f %5.2f', [l_one, l_two]));
With c_sort.Create Do
Begin
swap<Double>(l_one, l_two);
Free;
End;
display(Format('%5.2f %5.2f', [l_one, l_two]));
End; // generic_method_Click
|
Notez que
- le type ne figure pas dans l'en-tête de la Classe (il pourrait figurer, mais dans ce cas la définition de la méthode n'a pas besoin du paramètre)
Dans notre cas, comme la méthode n'utilise aucun champ de la Classe, nous pouvons utiliser une méthode de Classe:
Type c_sort_2=
Class
Class Procedure swap_2<T>(Var p_one, p_two: T);
End; // c_sort
Class Procedure c_sort_2.swap_2<T>(Var p_one, p_two: T);
Var l_temporary: T;
Begin
l_temporary:= p_one;
p_one:= p_two;
p_two:= l_temporary;
End; // c_swap_2
Procedure TForm1.generic_class_method_Click(Sender: TObject);
Var l_one, l_two: Double;
Begin
l_one:= 3.14;
l_two:= 20* pi;
display(Format('%5.2f %5.2f', [l_one, l_two]));
c_sort_2.swap_2<Double>(l_one, l_two);
display(Format('%5.2f %5.2f', [l_one, l_two]));
End; // generic_class_method_Click
|
Ici, comme d'ailleurs dans tous les exemples précédents, nous n'avons pa pu
effectuer de traitement sur les données de type T (addition, comparaison), car le compilateur n'ayant pas le type réel lors de la compilation du générique, ne peut faire ses vérifications. Ceci sera résolu par les contraintes que nous
présenterons ci-dessous. Nous pourrions à peu près résoudre ce type de problème en important à la fois les données et les traitements sur ces données. Voici un exemple:
Type t_gf_compare<T>= Function(p_one, p_two: T): Boolean;
c_math=
Class
Function f_max<T>(p_one, p_two: T;
p_gf_compare: t_gf_compare<T>): T;
End; // c_math
Function c_math.f_max<T>(p_one, p_two: T;
p_gf_compare: t_gf_compare<T>): T;
Begin
If p_gf_compare(p_one, p_two)
Then Result:= p_one
Else Result:= p_two;
End; // f_max<T>
// -- utilisation
Function f_greater(p_one, p_two: Integer): Boolean;
Begin
Result:= p_one> p_two;
End;
Var g_c_math: c_math;
Procedure TForm1.generic_compare_Click(Sender: TObject);
Var l_one, l_two, l_greater: Integer;
Begin
l_one:= 5;
l_two:= 30;
g_c_math:= c_math.Create;
l_greater:= g_c_math.f_max<Integer>(l_one, l_two, f_greater);
display(Format('one %d two %d greater= %d',
[l_one, l_two, l_greater]));
End; // generic_compare_Click
| Mais quelles contorsions pour comparer deux simples entiers !
5.7 - Interfaces génériques En plus des Classes, les Interfacees peuvent également utiliser des paramètres génériques. Voici une définition d'Interface:
Type i_add_to_list<T>=
Interface
Procedure add_to_list(p_item: T);
Function f_item(p_index: Integer): T;
End; // i_add_to_list<T>
| Notez que
- nous ne sommes pas forcés d'utiliser de GUID dans la définition de l'Interface (si nous d'utilisons pas par la suite QueryInterface, GetInterface ou As)
Voici une Classe qui implémente cette Interface et son utilisation:
Type c_list<T>=
Class(tInterfacedObject, i_add_to_list<T>)
m_c_list: tList<T>;
Constructor create_list;
Procedure add_to_list(p_item: T);
Function f_item(p_index: Integer): T;
Destructor Destroy; Override;
End; // c_list<T>
Constructor c_list<T>.create_list;
Begin
m_c_list:= tList<T>.Create;
End; // create_list
Procedure c_list<T>.add_to_list(p_item: T);
Begin
m_c_list.Add(p_item);
End; // add_to_list
Function c_list<T>.f_item(p_index: Integer): T;
Begin
Result:= m_c_list[p_index];
End; // f_item
Destructor c_list<T>.Destroy;
Begin
m_c_list.Free;
Inherited;
End; // Destroy
| Notez que - nous devons hériter de tInterfacedObject ou d'une Classe qui hérite de
tInterfacedObject
- comme tList<T> hérite de tEnumerable<T>, qui lui même n'hérite pas de tInterfacedObject, nous avons utilisé un champ tList<T>
Et deux utilisations possibles
- en créant un objet de type c_list<Integer>
Var g_c_integer_list: c_list<Integer>= Nil;
Procedure TForm1.implementing_class_Click(Sender: TObject);
Begin
g_c_integer_list:= c_list<Integer>.create_list;
With g_c_integer_list Do
Begin
add_to_list(123);
add_to_list(456);
display(Format('Item[%d]= %d', [0, f_item(0)]));
display(Format('Item[%d]= %d', [1, f_item(1)]));
Free;
End; // with g_c_integer_list
End; // implementing_class_Click
| - en utilisant un pointeur d'Interface :
Procedure TForm1.interface_pointer_Click(Sender: TObject);
Var l_i_integer_list: i_add_to_list<Integer>;
l_index: Integer;
Begin
l_i_integer_list:= c_list<Integer>.create_list;
With l_i_integer_list Do
Begin
add_to_list(123);
add_to_list(456);
For l_index:= 0 To 1 Do
display(Format('Item[%d]= %d', [l_index, f_item(l_index)]));
End; // with l_i_integer_list
End; // interface_pointer_Click
|
Nous aurions aussi pu créer une Classe qui implémente notre Interface
générique en précisant le paramètre actuel: Type c_integer_array=
Class(tInterfacedObject, i_add_to_list<Integer>)
m_item_integer_array: Array Of Integer;
m_sequence_index: Integer;
Constructor create_integer_array;
Procedure add_to_list(p_item: Integer);
Function f_item(p_index: Integer): Integer;
Destructor Destroy; Override;
End; // c_integer_array
Constructor c_integer_array.create_integer_array;
Begin
SetLength(m_item_integer_array, 16);
End; // create_integer_array
Procedure c_integer_array.add_to_list(p_item: Integer);
Begin
If m_sequence_index>= Length(m_item_integer_array)
Then SetLength(m_item_integer_array, 2* Length(m_item_integer_array));
m_item_integer_array[m_sequence_index]:= p_item;
Inc(m_sequence_index);
End; // add_to_list
Function c_integer_array.f_item(p_index: Integer): Integer;
Begin
Result:= m_item_integer_array[p_index];
End; // f_item
Destructor c_integer_array.Destroy;
Begin
m_item_integer_array:= Nil;
Inherited;
End; // Destroy
// -- using
Procedure TForm1.implement_integer_interface_Click(Sender: TObject);
Var l_index: Integer;
Begin
With c_integer_array.create_integer_array Do
Begin
add_to_list(123);
add_to_list(456);
For l_index:= 0 To 1 Do
display(Format('Item[%d]= %d', [l_index, f_item(l_index)]));
Free;
End; // with l_i_integer_list
End; // implement_integer_interface_Click
|
5.8 - Le Design Pattern Observer 5.8.1 - Observer classique
Nous allons présenter un exemple plus consistant avec le Design Pattern Observer. Dans cet exemple - un sujet est la météo qui varie (pour nous un timer qui génère des températures et taux d'humidité Random)
- un (ou plusieurs) observateurs souhaitent être notifiés de ces modifications
5.8.2 - Observer classique Une implémentation classique utilisant des Interfaces serait la suivante
- le couple subject / observer est défini par:
Unit u_i_subject_observer;
Interface
Type i_subject= Interface; // forward
i_observer=
Interface
['{92DA1578-996E-4E3A-965C-CCDDB1F30CC8}']
Procedure update_observer(p_i_subject: i_subject);
End; // i_observer
i_subject=
Interface
['{D53BC8BB-E7B8-437B-99A7-6EBF7D5F2309}']
Procedure add_observer(p_i_observer: i_observer);
Procedure remove_observer(p_i_observer: i_observer);
Procedure notify_observers;
End; // i_subject
Implementation
End | - les fonctionnalités du sujet ne dépendent pas du sujet concret. C'est pourquoi nous pouvons les implémenter dans une classe c_subject
Unit u_c_subject;
Interface
Uses Classes, u_i_subject_observer;
Type c_subject=
Class(TInterfacedObject, i_subject)
Private
m_c_observer_list: TInterfaceList;
// -- a reference to the final subject, to be able
// -- to send it to the observers when sends notifications
m_i_subject_ref: i_subject;
Public
Constructor create_subject(p_i_subject_ref: i_subject);
// -- i_subject implementation
Procedure add_observer(p_i_observer: i_observer);
Procedure remove_observer(p_i_observer: i_observer);
Procedure notify_observers;
Destructor Destroy; Override;
End; // c_subject
Implementation
// -- c_subject
Constructor c_subject.create_subject(p_i_subject_ref: i_subject);
Begin
Inherited Create;
m_c_observer_list:= TInterfaceList.Create;
m_i_subject_ref:= p_i_subject_ref;
End; // create_subject
Procedure c_subject.add_observer(p_i_observer: i_observer);
// -- add a new observer to the list
Begin
If m_c_observer_list.IndexOf(p_i_observer)= - 1
Then Begin
p_i_observer._AddRef;
m_c_observer_list.Add(p_i_observer);
End;
End; // add_observer
Procedure c_subject.remove_observer(p_i_observer: i_observer);
// -- remove an observer from the list
Begin
If m_c_observer_list.IndexOf(p_i_observer)<> - 1
Then m_c_observer_list.Remove(p_i_observer);
End; // remove_observer
Procedure c_subject.notify_observers;
// -- notifies all the observers (and they will use
// -- m_i_subject to get the information from the subject)
Var l_observer_index: integer;
Begin
For l_observer_index:= 0 To m_c_observer_list.Count- 1 Do
i_observer(m_c_observer_list[l_observer_index]).update_observer(m_i_subject_ref);
End; // notify_observers
Destructor c_subject.destroy;
Begin
m_c_observer_list.Free;
Inherited;
End; // destroy
End |
- notre sujet concret, la météo, capte les variations, et notifie tous les observateurs qui se sont abonnés:
Unit u_c_meteo_subject_2;
Interface
Uses , ExtCtrls // tTimer
, u_i_subject_observer
, u_c_subject
;
Type // -- needs an interface to get meteo from update(i_subject)
i_meteo=
Interface
['{83EF5DD2-9F1D-4BE9-8F97-57BE0BDED25C}']
Function f_temperature: integer;
Function f_humidity: integer;
End; // i_meteo
c_meteo_subject_2=
Class(c_subject, i_meteo)
m_temperature: integer;
m_humidity: integer;
m_c_timer: TTimer;
Constructor create_meteo_subject;
Procedure handle_timer_event(Sender: TObject);
Function f_temperature: integer;
Function f_humidity: integer;
Destructor destroy; Override;
End; // c_meteo_subject_2
Implementation
{ c_meteo_subject_2 }
Constructor c_meteo_subject_2.create_meteo_subject;
Begin
Inherited create_subject(Self);
// -- the timer to simulate measurements
m_c_timer:= TTimer.Create(Nil);
m_c_timer.Interval := 1000;
m_c_timer.OnTimer:= handle_timer_event;
End; // create_meteo_subject
Function c_meteo_subject_2.f_temperature: integer;
Begin
Result:= m_temperature;
End; // f_temperature
Function c_meteo_subject_2.f_humidity: integer;
Begin
Result:= m_humidity;
End; // f_humidity
Procedure c_meteo_subject_2.handle_timer_event(Sender: TObject);
Begin
m_temperature:= 12+ random(23);
m_humidity:= 52+ random(35);
notify_observers;
End; // handle_timer_event
Destructor c_meteo_subject_2.destroy;
Begin
m_c_timer.Free;
Inherited;
End;
End | - et nous utiliserons une Forme comme observateur :
Unit u_41_generic_observer;
Interface
Uses Windows, ...
, u_i_subject_observer
;
Type TForm1 =
Class(TForm, i_observer)
Memo1: TMemo;
create_meteo_: TButton;
Private
Procedure update_observer(p_i_subject: i_subject);
Public
End; // tForm1
Var
Form1: TForm1;
Implementation
Uses u_display_simple
, u_c_subject
, u_c_meteo_subject_2
;
{$R *.dfm}
Var g_c_meteo: c_meteo_subject_2= Nil;
Procedure TForm1.update_observer(p_i_subject: i_subject);
Var l_i_meteo: i_meteo;
Begin
l_i_meteo:= p_i_subject As i_meteo;
display(Format('temp %5d %5d',
[g_c_meteo.m_temperature, l_i_meteo.f_temperature]));
End; // update_observer
Procedure TForm1.create_meteo_Click(Sender: TObject);
Begin
g_c_meteo:= c_meteo_subject_2.create_meteo_subject;
g_c_meteo.add_observer(Self);
End; // create_meteo_Click
End.
|
Notez que - nous sommes obligés de définir une Interface i_observer pour que nous puissions ajouter cette Interface à tForm1
- nous sommes aussi obligés d'utiliser le surtypage à deux endroits :
- dans c_subject.notify_observers, car notre liste est une tInterfaceList, et pour appeler update_observer il faut bien que l'élément de la liste soit un i_observer
- plus grave, dans un observer, pour récupérer un objet qui sait nous retourner une température, nous devons caster le pointeur p_i_subject par AS
5.8.3 - Observer utilisant les Génériques
Nous pouvons nous affanchir de ces deux surtypages en utilisant les génériques : - voici la définition des subject / observer
Unit u_i_generic_subject_observer;
Interface
Type i_subject<S>= Interface; // forward
i_observer<S>=
Interface
['{92DA1578-996E-4E3A-965C-CCDDB1F30CC8}']
Procedure update_observer(p_c_subject: S);
End; // i_observer
i_subject<S>=
Interface
['{D53BC8BB-E7B8-437B-99A7-6EBF7D5F2309}']
Procedure add_observer(p_i_observer: i_observer<S>);
Procedure remove_observer(p_i_observer: i_observer<S>);
Procedure notify_observers;
End; // i_subject
Implementation
End | - la Class c_subject
Unit u_c_generic_subject;
Interface
Uses Classes, Generics.Collections
, u_i_generic_subject_observer
;
Type c_subject<S>=
Class(TInterfacedObject, i_subject<S> )
Private
m_c_observer_list: tList< i_observer<S> >;
m_c_subject_ref: S;
Public
Constructor create_subject(p_c_subject_ref: S);
// -- i_subject implementation
Procedure add_observer(p_i_observer: i_observer<S>);
Procedure remove_observer(p_i_observer: i_observer<S>);
Procedure notify_observers;
Destructor Destroy; Override;
End; // c_subject
Implementation
// -- c_subject
Constructor c_subject<S>.create_subject(p_c_subject_ref: S);
Begin
Inherited Create;
m_c_observer_list:= tList< i_observer<S> >.Create;
m_c_subject_ref:= p_c_subject_ref;
End; // create_subject
Procedure c_subject<S>.add_observer(p_i_observer: i_observer<S>);
Begin
If m_c_observer_list.IndexOf(p_i_observer)= - 1
Then Begin
p_i_observer._AddRef;
m_c_observer_list.Add(p_i_observer);
End;
End; // add_observer
Procedure c_subject<S>.remove_observer(p_i_observer: i_observer<S>);
Begin
If m_c_observer_list.IndexOf(p_i_observer)<> - 1
Then m_c_observer_list.Remove(p_i_observer);
End; // remove_observer
Procedure c_subject<S>.notify_observers;
Var l_observer_index: integer;
Begin
For l_observer_index:= 0 To m_c_observer_list.Count- 1 Do
m_c_observer_list[l_observer_index].update_observer(m_c_subject_ref);
End; // notify_observers
Destructor c_subject<S>.destroy;
Begin
m_c_observer_list.Free;
Inherited;
End; // destroy
End | - le sujet c_meteo concret :
Unit u_c_meteo_subject_4;
Interface
Uses Classes
, ExtCtrls // tTimer
, u_i_generic_subject_observer
, u_c_generic_subject
;
Type c_meteo =
Class(c_subject<c_meteo> )
Private
m_temperature: integer;
m_humidity: integer;
m_c_timer: TTimer;
Public
Constructor create_meteo_subject;
Procedure handle_timer_event(Sender: TObject);
Function f_temperature: integer;
Function f_humidity: integer;
Destructor destroy; Override;
End; // c_meteo_subject_2
Implementation
{ c_meteo_subject_2 }
Constructor c_meteo.create_meteo_subject;
Begin
Inherited create_subject(Self);
// -- the timer to simulate measurements
m_c_timer:= TTimer.Create(Nil);
m_c_timer.Interval := 1000;
m_c_timer.OnTimer:= handle_timer_event;
End; // create_meteo_subject
Function c_meteo.f_temperature: integer;
Begin
Result:= m_temperature;
End; // f_temperature
Function c_meteo.f_humidity: integer;
Begin
Result:= m_humidity;
End; // f_humidity
Procedure c_meteo.handle_timer_event(Sender: TObject);
Begin
m_temperature:= 12+ random(23);
m_humidity:= 52+ random(35);
notify_observers;
End; // handle_timer_event
Destructor c_meteo.destroy;
Begin
m_c_timer.Free;
Inherited;
End;
End | - et la Forme qui observe le temps:
Unit u_44_generic_observer;
Interface
Uses Windows, ...
, u_i_generic_subject_observer
, u_c_generic_subject
, u_c_meteo_subject_4
;
Type TForm1 =
Class(TForm, i_observer<c_meteo>)
Memo1: TMemo;
Procedure create_meteo_Click(Sender: TObject);
Private
Procedure update_observer(p_c_subject: c_meteo);
Public
End;
Var Form1: TForm1;
Implementation
Uses u_display_simple;
{$R *.dfm}
Procedure TForm1.update_observer(p_c_subject: c_meteo);
Begin
display(Format('temp %5d',
[p_c_subject.f_temperature]));
End; // update_observer
Var g_c_meteo: c_meteo= Nil;
Procedure TForm1.create_meteo_Click(Sender: TObject);
Begin
g_c_meteo:= c_meteo.create_meteo_subject;
g_c_meteo.add_observer(Self);
End; // create_meteo_Click
End.
|
De plus - pour l'itération de notification, au lieu de FOR l_index, nous aurions pu utiliser FOR IN :
Var l_S: i_observer<S>;
For l_S In m_c_observer_list Do
l_S.update_observer(m_c_subject_ref);
|
6 - Contraintes sur le type générique 6.1 - Contraintes sur le paramètre générique Les types génériques semblent donc idéaux pour permettre la construction de
librairies permettant, par exemple, les calculs statistiques (moyenne, variance, tests divers), le techniques matricielles (inversion, opérations, vecteurs propres), les constructions géométriques (espaces 3d, transformations).
Ce n'est pas possible dans la version de base que nous avons présentée jusqu'à présent. La raison est simple à comprendre: comme le compilateur ne sait rien sur le type des paramètres T, il ne peut faire aucune opération sur des
données de type T: - si la valeur actuelle choisie pour de T était une String, il n'aurait pas le droit de multiplier deux T
- si c'était un Integer, la division devrait être DIV et si c'était un
Double, c'est / qu'il faudrait utiliser
- si c'est une Class, T pourrait avoir un Constructor et hériter
Dans le doute, pour un langage fortement typé comme Delphi, le Compilateur
interdira tout opération qu'il ne peut vérifier. L'idée est alors de limiter l'ensemble des T possible à des catégories pour lesquelles certains traitement sont possibles. En acceptant que le paramètre
actuel devra appartenir à la catégorie spécifiée - le compilateur autorisera les opérations possibles sur cette catégorie
- le compilateur vérifiera que les paramètres actuels que nous choisirons
appartiennent effectivement à cette catégorie
Ces limitations sont appelées des contraintes.
<T> peut être obligé - d'implémenter une certaine Interface, i_mon_interface ou
i_mon_interface<T>
- d'être au moins de type Class (ou Record)
- d'être de type, ou un descendant de c_ma_classe ou c_ma_classe<T>
- d'avoir un Constructor "par défaut" (Public, et sans paramètre)
6.2 - Contrainte Interface 6.2.1 - Contrainte générique i_equal
Pour pouvoir rechercher un élément dans une liste, il faut pouvoir tester l'égalité. Nous avons donc défini une Interface avec un test d'égalité:
Type i_equal_to<T_equal> =
Interface
Function f_equal_to(p_i_equal_to: T_equal): Boolean;
Function f_display: String;
End; // i_equal_to<T_equal>
|
Notre conteneur contiendra des cellules de n'importe quel type T, à condition que nous puissions tester l'égalité:
Type c_item_list<T : i_equal_to<T> > =
Class
m_array: Array Of T;
Procedure add_item(p_item: T);
Function f_indexof(p_item: T): Integer;
End; // c_item_list<T ...>
Procedure c_item_list<T>.add_item(p_item: T);
Begin
SetLength(m_array, Length(m_array)+ 1);
m_array[Length(m_array)- 1]:= p_item;
End; // add_item
Function c_item_list<T>.f_indexof(p_item: T): Integer;
Var l_index: Integer;
Begin
For l_index := 0 To Length(m_array) - 1 Do
Begin
display(Format('%2d %s', [l_index, m_array[l_index].f_display]));
// -- compiler did accept T.f_equal_to
If m_array[l_index].f_equal_to(p_item)
Then Begin
Result:= l_index;
Break;
End;
End;
End; // f_indexof
|
Et voici un exemple de classe c_person, dûment dotée d'une fonction de test d'égalité:
Type c_person=
Class(tInterfacedObject, i_equal_to<c_person>)
m_firstname: String;
Constructor create_person(p_firstname: String);
Function f_equal_to(p_i_equal_to: c_person): Boolean;
Function f_display: String;
End; // c_cell
Constructor c_person.create_person(p_firstname: String);
Begin
m_firstname:= p_firstname;
End; // create_person
Function c_person.f_display: String;
Begin
Result:= m_firstname;
End; // f_display
Function c_person.f_equal_to(p_i_equal_to: c_person): Boolean;
Begin
Result:= m_firstname= p_i_equal_to.m_firstname;
End; // f_equal_to
// -- using
Procedure TForm1.indexof_Click(Sender: TObject);
Var l_indexof: Integer;
l_c_target_person: c_person;
Begin
With c_item_list<c_person>.create Do
Begin
add_item(c_person.create_person('louis'));
add_item(c_person.create_person('joe'));
add_item(c_person.create_person('sam'));
l_c_target_person:= c_person.create_person('joe');
l_indexof:= f_indexof(l_c_target_person);
Free;
End;
End; // indexof_Click
| Notez que - le compte d'utilisation n'est pas utilisé (le conteneur n'est pas une Classe implémentant une Interface, c'est la cellule qui l'est)
6.2.2 - Utilisation directe de l'Interface Au lieu de génériques avec des contraintes, il est souvent possible d'utiliser directement l'Interface. Dans l'exemple ci-dessous, nous avons directement implémenté une liste de
personnes: Type i_equal_to<T>=
Interface
Function f_are_equal(p_c_one, p_c_two: T): Boolean;
Function f_display(p_c_T: T): String;
End;
c_item_list =
Class(tInterfacedObject, i_equal_to<c_person>)
m_array: Array Of c_person;
// -- i_equal_to
Function f_are_equal(p_c_one, p_c_two: c_person): Boolean;
Function f_display(p_c_T: c_person): String;
Procedure add_item(p_item: c_person);
Function f_indexof(p_item: c_person): Integer;
End; // c_item_list
| avec l'utilisation suivante
Procedure TForm1.person_list_Click(Sender: TObject);
Var l_indexof: Integer;
l_c_target_person: c_person;
Begin
With c_item_list.create Do
Begin
add_item(c_person.create_person('louis', 22));
add_item(c_person.create_person('joe', 33));
add_item(c_person.create_person('sam', 44));
l_c_target_person:= c_person.create_person('joe', 33);
l_indexof:= f_indexof(l_c_target_person);
Free;
End; // with c_item_list
End; // person_list_Click
| Notez toutefois que - cette solution est moins générique (nous ne pouvons pas créer une liste de
Double, par exemple)
- si nous utilisons un pointeur d'Interface pour utiliser la comparaison, le compte de référence sera employé. Dans ce cas nous n'aurions pas accès aux autres méthodes de la Classe
6.3 - Contrainte Class Nous pouvons aussi imposer que notre type concret soit une Classe: Voici une classe qui contiendra une autre Classe T:
Type c_data_container <T: Class> =
Class
Private
m_c_data: T;
Public
Constructor create_data_container(p_c_data: T);
Procedure display_data;
Function ToString: String; Override;
Destructor Destroy; Override;
End; // c_data_container
|
Comme m_c_data est une Classe, nous pouvons utiliser toutes les propriétés, méthodes et événements des Classes. Voici quelques exemples:
Procedure c_data_container<T>.display_data;
Begin
If Assigned (m_c_data) Then
Begin
display('ClassName: ' + m_c_data.ClassName);
display('Size: ' + IntToStr (m_c_data.InstanceSize));
display('ToString: ' + m_c_data.ToString);
End;
End; // display_data
Function c_data_container<T>.ToString: String;
Begin
// -- can use ToString since m_c_data is in tObject
Result:= 'c_data_container<T>.ToString '+ m_c_data.ToString;
End; // ToString
Destructor c_data_container<T>.Destroy;
Begin
m_c_data.Free;
Inherited;
End; // Destroy
| Notez que
- ClassName, ToString et Free sont possible par T sera nécessairement une Classe
- nous avons même pu surcharger ToString
et voici une utilisation:
Procedure TForm1.data_container_Click(Sender: TObject);
Var l_c_person: c_person;
Begin
l_c_person:= c_person.create_person('Miller', 44);
With c_data_container<c_person>.create_data_container(l_c_person) Do
Begin
display_data;
display(ToString);
Free;
End; // with c_data_container
End; // data_container_Click
| Naturellement: - si nous créons un objet avec un paramètre actuel qui n'est pas une Classe, (par exemple c_data_container<Integer>), une erreur de compilation sera provoquée
6.4 - Obligation d'hériter d'une Classe spécifique Nous pouvons même forcer les paramètres actuels à hériter d'une Classe particulière. Créons une liste qui permet d'effectuer des traitements sur tous les contrôles
d'une Forme, comme par exemple aligner, déplacer en groupe etc. Plusieurs solutions existent déjà - utilise le tableau Controls qui est une propriété tableau de cellules
tControl. Nous pourrions déplacer les contrôle, mais le traitement (le For) serait sur la Forme
- nous pourrions une Class dérivant d'un conteneur usuel (tList,
tObjectList), mais il faudrait surtyper l'élément Pointer ou tObject
- une Classe dérivant de tList<T> avec un paramètre actuel tWinControl
permettrait d'accéder aux éléments sans surtypage, mais nous ne pouvons accéder au propriétés de chaque élément, car le paramètre T n'est pas considéré comme un tWinControl
La solution est donc d'utiliser effectivement un descendant de tList<T> en imposant un contrainte pour que le paramètre T soit un tWinControl. Voici notre conteneur:
Procedure TForm1.data_container_Click(Sender: TObject);
Var l_c_person: c_person;
Begin
l_c_person:= c_person.create_person('Miller', 44);
With c_data_container<c_person>.create_data_container(l_c_person) Do
Begin
display_data;
display(ToString);
Free;
End; // with c_data_container
End; // data_container_Click
| et son utilisation:
Var g_c_wincontrol_list: c_wincontrol_list<tWinControl> ;
Procedure TForm1.create_control_list_Click(Sender: TObject);
Begin
g_c_wincontrol_list:= c_wincontrol_list<tWinControl>.Create ;
g_c_wincontrol_list.Add(Edit1);
g_c_wincontrol_list.Add(CheckBox1);
g_c_wincontrol_list.Add(StringGrid1);
End; // create_control_list_Click
Procedure TForm1.move_controls_left_Click(Sender: TObject);
Begin
g_c_wincontrol_list.move_left(5);
End; // move_controls_left_Click
|
6.5 - Contrainte Record
La contrainte Record est similaire à la contrainte Classe
6.6 - Contrainte Constructor Si nous imposons une contrainte Classe, nous pouvons en plus exiger que le
paramètre actuel soit muni d'un Constructor Create sans paramètre Ceci permettra, naturellement, de créer des objets à partir du paramètre T. L'exemple type est le pattern Factory, sous de nombreuses formes d'ailleurs.
Dans notre exemple, nous allons construire une liste (nom_de_classe, référence_de_classe). Dans de nombreux articles nous avons présenté cette technique qui met à profit le fait que Delphi peut créer un objet à partir d'une référence de classe.
Dans notre cas, au lieu d'utiliser une tStringList, avec le nom de la classe dans Strings, et la référence de classe dans Objects, nous allons utiliser un tDictionary. Voici le détail
- les Classes à instancier sont définies par
Type c_ancestor=
Class
End; // c_ancestor
c_a=
Class(c_ancestor)
End; // c_a
c_b=
Class(c_ancestor)
End; // c_b
| - voici notre factory:
Type c_object_factory< T: Class, Constructor >=
Class
m_c_dictionary: TDictionary< string, tClass> ;
Constructor create_object_factory;
Procedure register_class<U>;
Function f_c_instance(p_class_name: string): T;
Destructor Destroy; Override;
End; // c_object_factory<T>
|
notez que le dictionnaire a comme valeur des références de classe, tClass - cette factory est implémentée ainsi:
Constructor c_object_factory<T>.create_object_factory;
Begin
Inherited Create;
m_c_dictionary:= TDictionary< string, tClass>.Create;
End; // create_object_factory
Procedure c_object_factory<T>.register_class<U>;
Var l_pt_type_info: PTypeInfo;
l_class_type: tClass;
Begin
l_pt_type_info := PTypeInfo(TypeInfo(U));
l_class_type:= GetTypeData(l_pt_type_info).ClassType;
display(Format('register ''%s'' class %s ',
[l_pt_type_info.Name, l_class_type.ClassName]));
m_c_dictionary.Add(l_pt_type_info.Name, l_class_type);
End; // register_class<U>
Function c_object_factory<T>.f_c_instance(p_class_name: string): T;
Var l_T_class: tClass;
Begin
l_T_class:= m_c_dictionary[p_class_name];
// -- if does not case, E2010
// Result:= l_T_class.Create;
Result:= T(l_T_class.Create);
End; // f_c_instance
Destructor c_object_factory<T>.Destroy;
Begin
m_c_dictionary.Free;
Inherited;
End; // Destroy
| et nous avons utilisé RTTI pour récupérer à partir d'une Classe le nom et la référence de Classe
- et peut être utilisé ainsi
Var g_c_object_factory: c_object_factory<c_ancestor>= Nil;
Procedure TForm1.create_factory_list_Click(Sender: TObject);
Begin
g_c_object_factory:= c_object_factory<c_ancestor>.create_object_factory;
g_c_object_factory.register_class<c_a>;
g_c_object_factory.register_class<c_b>;
End; // create_factory_list_Click
Procedure TForm1.create_a_Click(Sender: TObject);
Var l_c_a: c_ancestor;
Begin
l_c_a:= g_c_object_factory.f_c_instance('c_a');
display('created '+ l_c_a.ClassName);
l_c_a.Free;
End; // create_a_Click
|
En ce qui concerne la contrainte Constructor, - le Constructor est sans paramètre
- si la classe a un Constructor avec paramètre, c'est tObject.Create qui sera appelé
- il est possible de combiner (raisonablement) les contraintes Interface, Class et Constructor
6.7 - Non Rooted Delphi Types Delphi a toutefois une limitation du fait que toutes les données ne sont pas
des Classes. De ce fait nous ne pouvons pas facilement effectuer des opérations sur un type T qui n'est pas une Classe. Par exemple une calculette sur un type T avec
un type actuel Integer ou Double n'est pas directement possible, car nous ne pouvons pas indiquer au compilateur comment utiliser "+" ou "-". Et nous ne pouvons fournir d'opérateur génériques.
La solution est alors d'introduire quelques indirections. Voici une calculette (nous n'avons fait que la multiplication) :
7 - Librairie Générique Vcl 7.1 - Comparaisons et égalités La Vcl contient
- une Interface IComparer<T> avec une méthode Compare, et elle est implémentée par une Classe tComparer<T>.
Cette Interface est ensuite utilisée par les conteneurs (tList<T>) ou
nous pouvons implémenter un descendant de tComparer<T> comme nous l'avons fait ci-dessus
- une Interface iEqualityComparer, qui suit le même schéma
Voici le diagramme de Classe UML schématique de l'ensemble :
Voici un exemple simple de tri d'une tList<c_person>:
Type c_person_comparer=
Class(tComparer<c_person>)
Function Compare(Const Left, Right: c_person): Integer; Override;
End;
Function c_person_comparer.Compare(Const Left, Right: c_person): Integer;
Begin
If Left.m_first_name< Right.m_first_name
Then Result:= -1
Else
If Left.m_first_name> Right.m_first_name
Then Result:= 1
Else Result:= 0;
End; // Compare
Var g_c_person_list: tList<c_person>= Nil;
Procedure TForm1.sort_person_list_Click(Sender: TObject);
Var l_i_comparer: IComparer<c_person>;
l_c_person: c_person;
Begin
g_c_person_list:= tList<c_person>.Create;
g_c_person_list.Add(c_person.create_person('mike', 24));
g_c_person_list.Add(c_person.create_person('anna', 18));
g_c_person_list.Add(c_person.create_person('sam', 55));
display('list');
For l_c_person In g_c_person_list Do
display(l_c_person.ToString);
l_i_comparer:= c_person_comparer.Create();
g_c_person_list.Sort( l_i_comparer );
display('');
display('sorted list');
For l_c_person In g_c_person_list Do
display(l_c_person.ToString);
End; // sort_person_list_Click
|
Notez que
- tComparison, tEqualityComparison et tHasher sont des méthodes anonymes que nous pouvons utiliser au lieu de créer des descendants de tComparer ou tEqualityComparer
- il existe encore d'autres Classes dans GENERICS.DEFAULT.PAS, dérivées des classes précédentes.
7.2 - Enumération La librairie offre aussi des tEnumerator<T> et tEnumerable<T>, qui sont les
ancêtres de tList<T>, tQueue<T> etc. Voici le diagramme de classe UML
Notez que
- dans SYSTEM.PAS il existe bien des iEnumerable, iEnumerator, iComparable, iEquatable :
Ces fonctions sont "Sytem" (compiler magic) car les signatures ne sont pas les mêmes au niveau des ancêtres et des descendants. De plus nous n'avons pas trouvé d'utilisation de ces définitions dans la VCL.
De plus, ces définitions ne sont pas directement liés à celles de GENERICS.DEAFAULT.PAS et GENERICS.COLLECTIONS.PAS. En fait un tEnumerator<T> ne descend pas d'une Interface iEnumerator<T> car Delphi
par rooté: que devrait donc returner iEnumerator<T>.Current ? De ce faut tous les conteneurs devront utiliser l'héritage de tEnumerable, au lieu de simplement implémenter iEnumerable
- le fait que tList<T> descende de tEnumerator<T> explique que
- nous pouvons utiliser FOR xxx IN pour nos tList<T>
- nos tList<T> ne descendent pas de tInterfacedObject (et nous ne pouvons pas manipuler _QueryInterface, _AddRef, _Release). Encore que comme avec les génériques nous utilisons plus les objets que les pointeurs
d'Interfaces, cela ne devrait pas trop nous manquer
- la conclusion pour certains est qu'il vaut mieux redéfinir les Interfaces énumérateurs et comparaisons pour éviter les ambiguités entre ces différentes définitions
La librairie comporte en fait deux groupes de conteneurs: - des conteneurs descendant directement de tEnumerable
TList<T> = class(TEnumerable<T>) ooo end;
TQueue<T> = class(TEnumerable<T>) = ooo end;
TStack<T> = class(TEnumerable<T>) = ooo end;
TDictionary<TKey, TValue> = class(TEnumerable<TPair<TKey, TValue>>) = ooo end;
- des conteneurs utilisables pour les objets (contrainte Class)
TObjectList<T: class> = class(TList<T>) = ooo end;
TObjectQueue<T: class> = class(TQueue<T>) = ooo end;
TObjectStack<T: class> = class(TStack<T>) = ooo end;
TObjectDictionary<TKey, TValue> = class(TDictionary<TKey, TValue>) = ooo end;
et
- si tObjectList.OwnsObject est True, l'objet est libéré lorsque nous retirons l'élément de la liste
- pour le dictionnaire, peut être propriétaire de la clé, la valeur ou les deux
Mentionnons aussi
- que SYSTEM.PAS contient des définition de
- iEnumerator et iEnumerator<T>
- iEnumerable et iEnumerable<T>
- iEquatable et iEquatable<T>
- il existe aussi un type iObserver, défini dans SYTEM.CLASSES.PAS, mais sans version paramétrée. Il n'existe pas de iObservable
8 - Télécharger le code source Delphi Vous pouvez télécharger:
Comme d'habitude: - nous vous remercions de nous signaler toute erreur, inexactitude ou
problème de téléchargement en envoyant un e-mail à jcolibri@jcolibri.com. Les corrections qui en résulteront pourront aider les prochains lecteurs
- tous vos commentaires, remarques, questions, critiques, suggestion d'article, ou mentions d'autres sources sur le même sujet seront de même les bienvenus à jcolibri@jcolibri.com.
- plus simplement, vous pouvez taper (anonymement ou en fournissant votre e-mail pour une réponse) vos commentaires ci-dessus et nous les envoyer en cliquant "envoyer" :
- et si vous avez apprécié cet article, faites connaître notre site, ajoutez un lien dans vos listes de liens ou citez-nous dans vos
blogs ou réponses sur les messageries. C'est très simple: plus nous aurons de visiteurs et de références Google, plus nous écrirons d'articles.
9 - Références Quelques références
Pour quelques détails techniques
- Les Interfaces Delphi : définition, création, syntaxe et règles d'utilisation.
- les Constructeurs Virtuels et les Références de classes (VIRTUAL CONSTRUCTORS, CLASS OF). Utilisé pour
construire notre factory
- les design patterns Abstract Factory
et Bridge Présentation, diagrammes de classe UML et sources Delphi.
- Gof Design Patterns le codage en Delphi des 23
Design Patterns du livre des "Gang Of Four"
- Méthodes Anonymes Delphi : présentation,
capture de variables et clôture, Invoke, implémentation et analyse mémoire, exemple profiling, énumérateur filtré, téléchargement et traitement de pages Web dans un thread.
Les génériques et les anonymes sont présentés dans nos formations Delphi: - Formation Delphi Complète :
maîtriser Delphi XE : l'environnement, le langage Pascal et la programmation objet, les bases de données, applications Internet, Xml et les services web. Intègre les nouveautés XE3: unicode, génériques, méthodes anonymes, bases de
données multi-niveau, méthodes serveur, Visual LiveBindings, outils de gestion de projet, nouveautés de l'IDE
- Formation de Delphi 7 à Delphi Xe : mise à niveau concernant les nouveautés apparues dans les
version Delphi après Delphi 7 : l'environnement, la librairie (génériques, anonymes, RTTI), les composants (Ribbon Controls, Visual LiveBindings, Live Tiles Windows 8), l'ouverture vers Mac et les mobiles (FireMonkey), les
outils intégrés (Version, Profilage)
10 - L'auteur John COLIBRI est passionné par le développement Delphi et les applications de Bases de Données. Il a écrit de nombreux livres
et articles, et partage son temps entre le développement de projets (nouveaux projets, maintenance, audit, migration BDE, migration Xe_n,
refactoring) pour ses clients, le conseil (composants, architecture, test) et la
formation. Son site contient des articles
avec code source, ainsi que le programme et le calendrier des stages de formation Delphi, base de données, programmation objet, Services Web, Tcp/Ip et
UML qu'il anime personellement tous les mois, à Paris, en province ou sur site client.
|
