menu
  Home  ==>  articles  ==>  prog_objet_composants  ==>  delphi_generics   

Génériques Delphi - John COLIBRI.


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_listtList<Integer>;
    my_string_listtList<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_listtList<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_nameString;
           m_ageinteger;

           Constructor create_person(
               p_first_nameStringp_ageInteger);
           Function f_c_selfc_person;

           Function ToStringStringOverride;
         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_listtListNil;

Procedure TForm1.c_person__tlist_Click(SenderTObject);
  Var l_c_personc_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 Classesu_c_person;

    Type c_person_list=
             Class(tList)
               Constructor create_person_list;

               Function f_c_person(p_person_indexInteger): c_person;
               Procedure display_person_list;

               Destructor DestroyOverride;
             End// c_person

  Implementation
    Uses SysUtilsu_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_indexInteger): 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_indexInteger;
      Begin
        For l_person_index:= 0 To Count- 1 Do
          With f_c_person(l_person_indexDo
            display(ToString);
      End// display_person_list

    Destructor c_person_list.Destroy;
      Var l_person_indexInteger;
      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_listtList<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_personc_person;

      l_c_person:= g_c_generic_person_list[1];




Voici le code complet:

Uses Generics.Collections;

Var g_c_generic_person_listtList<c_person>= Nil;

Procedure TForm1.generic_person_list_Click(SenderTObject);
  Var l_c_personc_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

      tDictionary<Key, Value>


  • il peut y avoir plusieurs paramètres, comme le montre l'exemple du dictionnaire ci-dessus


Au niveau de l'utilisation
  • la valeur donnée au paramètre de type est appelé "argument de type" ou encore le "paramètre actuel". Ainsi, pour la déclaration de variable suivante

    Var g_c_generic_person_listtList<c_person>;

    c_person est le paramètre actuel

  • lorsque tous les paramètres de type ont été spécifiés, le type est "fermé". tList<Double> est "fermé"

  • si un ou plusieurs paramètres de types ne sont pas spécifiés, le type est un type ouvert (pas totalement spécifié). Voici deux types ouverts:

    tList<U>
    tDictionary<StringV>




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_arrayArray Of T;
               m_top_of_stackInteger;

               Constructor create_generic_stack(p_lengthInteger);
               Procedure push(p_genT);
               Function f_popT;
             End// c_generic_stack

  • et cette classe est implémentée ainsi;

    Constructor c_generic_stack<T>.create_generic_stack(p_lengthInteger);
      Begin
        Inherited Create;
        SetLength(m_gen_arrayp_length);
      End// create_generic_stack

    Procedure c_generic_stack<T>.push(p_genT);
      Begin
        If m_top_of_stackLength(m_gen_array)
          Then SetLength(m_gen_array, 2* Length(m_gen_array));

        If m_top_of_stackLength(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_popT;
      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
  • au niveau de la définition de la Classe
    • le paramètre T a été utilisé dans l'en-tête de la définition de la Classe
    • dans cette définition, T a pu être utilisé
      • pour des attributs
      • comme paramètre de méthodes
      • comme résultat de fonctions
    • nous aurions aussi pu utiliser T comme type d'une Property
    • en fait nous pouvons utiliser T partout ou nous aurions pu utiliser un type usuel, comme un Integer
    • mais nous ne pouvons pas utiliser T pour désigner un nom de méthode
  • pour l'implémentation, nous avons répété <T> devant chaque méthode. Si notre Unité avait une classe non générique ayant le même nom, la répétition de <T> évite la confusion entre la Classe générique et la Classe non générique.

    Ainsi le code qui suit est accepté:

    Type c_my_computer<T>=
             Class
               Procedure increment;
             End// c_generic_stack

         c_my_computer=
             Class
               Procedure increment;
             End// c_generic_stack

    Procedure c_my_computer<T>.increment;
      Begin
      End// increment

    Procedure c_my_computer.increment;
      Begin
      End// increment




L'utilisation se fait exactement comme pour la tList<T> :

Var g_c_generic_stackc_generic_stack<Integer>= Nil;

Procedure TForm1.generic_integer_stack_Click(SenderTObject);
  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_stackc_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_stackArray[1..5] Of c_generic_stack<Integer>;
        g_person_historyRecord
                            m_ageInteger;
                            m_c_task_stackc_generic_stack<Integer>;
                          End;

    Procedure compute_stack_average(p_c_integer_stackc_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_stackc_generic_stack<T>;
            End// c_structure<T>
         c_dictionary<KeyT>=
            Class
              m_c_stackc_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_listtList<Integer>;
        g_c_char_listtList<Char>;

        g_charChar;

    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_stackc_generic_buffered_stack<Integer>;
        g_c_display_integer_stackc_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_1Array[1..5] Of Integer;
        g_array_2Array[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_integerArray[1..5] Of Integer;
    Var g_array_5_1t_array_of_five_integer;
        g_array_5_2t_array_of_five_integer;

      g_array_5_1:= g_array_5_2;

    Mais pour les génériques :

    Type t_integer_listtList<Integer>;
    Var g_integer_list_1t_integer_list;
        g_integer_list_2tList<Integer>;
        g_integer_list_3tList<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_listtList<Pointer>;
        g_listtList;

      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 :
  • voici notre Classe, avec une méthode non-générique et une méthode générique:

    Type c_some_generic <T> =
             Class
                m_valueT;
                m_countInteger;

                Procedure non_generic;
                Procedure set_T (p_TT);
              End;

    Procedure c_some_generic<T>.non_generic;
      Begin
        Inc(m_count);
      End// non_generic

    Procedure c_some_generic<T>.set_T(p_TT);
      Begin
        m_value:= p_T;
      End// set_T

  • nous utilisons 3 paramètre réels et testons les adresses mémoires ainsi:

    Procedure TForm1.display_memory_address_Click(SenderTObject);

      Procedure display_address(p_titleStringp_addressInteger);
        Begin
         display(Format('%-25s $%8x', [p_titlep_address]));
        End// display_address

      Var l_c_integerc_some_generic<Integer>;
          l_c_stringc_some_generic<string>;
          l_c_buttonc_some_generic<tButton>;

      Begin // display_memory_address_Click
        l_c_integer := c_some_generic<Integer>.Create;
        l_c_integer.set_T (10);
        l_c_integer.non_generic;

        l_c_string := c_some_generic<string>.Create;
        l_c_string.set_T ('hello');
        l_c_string.non_generic;

        l_c_button:= c_some_generic<tButton>.Create;
        l_c_button.set_T (Exit_);
        l_c_button.non_generic;

        display_address('l_c_string.non_generic',  pInteger(@c_some_generic<string>.non_generic)^);
        display_address('l_c_integer.non_generic'pInteger(@c_some_generic<Integer>.non_generic)^);
        display_address('l_c_button.non_generic',  pInteger(@c_some_generic<tButton>.non_generic)^);

        display_address('l_c_string.set_T',        pInteger(@c_some_generic<string>.set_T)^);
        display_address('l_c_integer.set_T',       pInteger(@c_some_generic<Integer>.set_T)^);
        display_address('l_c_button.set_T',        pInteger(@c_some_generic<tButton>.set_T)^);
      End// display_memory_address_Click

  • et voici le résultat :

    method_addresses

    Nous constatons bien the les adresses des méthodes génériques ne sont pas les mêmes (pour les Integer et les tButton ce sont les mêmes, sans doute parce qu'il s'agit de 4 octets)




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_xm_ym_zT_coordinate;
         End// t_point

Var g_centert_point<Integer>;
    g_projectiont_point<Double>;

Procedure TForm1.generic_record_Click(SenderTObject);
  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_countst_array<Integer>;
    g_measurest_array<Double>;

    g_indexinteger;

    g_xy_arrayt_xy_array<Double>;

    g_array_of_doubleArray Of Double;

Procedure TForm1.generic_array_Click(SenderTObject);
  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_measurest_array<Double>;
    g_array_of_doubleArray 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_onep_twoT);

qui peut être utilisé pour des Integer (en utilisant DIV)

Procedure convert_two_integer(p_valuep_rateInteger);
  Begin
    display(Format('%4d    div %4d   = %d ',
        [p_valuep_ratep_value Div p_rate]));
  End// convert_two_integer

Procedure TForm1.convert_integer_Click(SenderTObject);
  Var l_gp_convert_two_integert_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_valuep_rateDouble);
  Begin
    display(Format('%7.2f div %7.2f= %g ',
        [p_valuep_ratep_value / p_rate]));
  End// convert_two_double

Procedure TForm1.convert_double_Click(SenderTObject);
  Var l_gp_convert_two_doublet_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_valueT): T;

         c_vector<T>=
             Class
               m_vectorArray[0..9] Of T;

               Constructor Create;
               Procedure compute(p_gf_handle_onet_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_onet_gf_handle_one<T>);
      Var l_indexInteger;
      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_valueInteger): Integer;
  Begin
    Result:= p_valuep_value;
  End// f_integer_square

Procedure display_vector(p_c_vectorc_vector<Integer>);
  Var l_indexInteger;
      l_resultString;
  Begin
    l_result:= '';
    For l_index:= 0 To 9 Do
      l_result:= l_resultIntToStr(p_c_vector.m_vector[l_index])+ ' ';
    display(l_result);
  End// display_vector

Procedure TForm1.apply_function_Click(SenderTObject);
  Var l_c_vectorc_vector<Integer>;
      l_indexInteger;
  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_valueTOf Object;

         c_storage<V>=
             Class
               m_tableArray Of V;

               m_on_notify_value_changedt_po_notify_change<V>;
               m_on_notify_storage_changedt_po_notify_changec_storage<V> >;

               Constructor create_storage(p_sizeInteger);
               Procedure add_value(p_indexIntegerp_valueV);
             End// c_storage

  Implementation

    // -- Type c_storage<V>

    Constructor c_storage<V>.create_storage(p_sizeInteger);
      Begin
        Inherited Create;
        SetLength(m_tablep_size);
      End// create_storage

    Procedure c_storage<V>.add_value(p_indexIntegerp_valueV);
      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_storagec_storage<Integer>;

           Constructor create_statistics;
           Procedure display_value_changed(p_valueInteger);
           Procedure display_storage_changed(p_c_storagec_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_valueInteger);
  Begin
    display('added_value 'IntToStr(p_value));
  End// display_value_changes

Procedure c_statistics.display_storage_changed(p_c_storagec_storage<Integer>);
  Var l_indexInteger;
  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_statisticsc_statistics;

Procedure TForm1.notify_addition_Click(SenderTObject);
  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_onep_twoT);
         End// c_sort

Procedure c_sort.swap<T>(Var p_onep_twoT);
  Var l_temporaryT;
  Begin
    l_temporary:= p_one;
    p_one:= p_two;
    p_two:= l_temporary;
  End// swap<T>

// -- example of use

Procedure TForm1.generic_method_Click(SenderTObject);
  Var l_onel_twoDouble;
  Begin
    l_one:= 3.14;
    l_two:= 20* pi;
    display(Format('%5.2f   %5.2f', [l_onel_two]));

    With c_sort.Create Do
    Begin
      swap<Double>(l_onel_two);
      Free;
    End;

    display(Format('%5.2f   %5.2f', [l_onel_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_onep_twoT);
         End// c_sort

Class Procedure c_sort_2.swap_2<T>(Var p_onep_twoT);
  Var l_temporaryT;
  Begin
    l_temporary:= p_one;
    p_one:= p_two;
    p_two:= l_temporary;
  End// c_swap_2

Procedure TForm1.generic_class_method_Click(SenderTObject);
  Var l_onel_twoDouble;
  Begin
    l_one:= 3.14;
    l_two:= 20* pi;
    display(Format('%5.2f   %5.2f', [l_onel_two]));

    c_sort_2.swap_2<Double>(l_onel_two);

    display(Format('%5.2f   %5.2f', [l_onel_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_onep_twoT): Boolean;

     c_math=
         Class
           Function f_max<T>(p_onep_twoT;
               p_gf_comparet_gf_compare<T>): T;
         End// c_math

Function c_math.f_max<T>(p_onep_twoT;
    p_gf_comparet_gf_compare<T>): T;
  Begin
    If p_gf_compare(p_onep_two)
      Then Result:= p_one
      Else Result:= p_two;
  End// f_max<T>

// -- utilisation

Function f_greater(p_onep_twoInteger): Boolean;
  Begin
    Result:= p_onep_two;
  End;

Var g_c_mathc_math;

Procedure TForm1.generic_compare_Click(SenderTObject);
  Var l_onel_twol_greaterInteger;
  Begin
    l_one:= 5;
    l_two:= 30;

    g_c_math:= c_math.Create;

    l_greater:= g_c_math.f_max<Integer>(l_onel_twof_greater);

    display(Format('one %d two %d   greater= %d',
        [l_onel_twol_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_itemT);
           Function f_item(p_indexInteger): 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(tInterfacedObjecti_add_to_list<T>)
           m_c_listtList<T>;

           Constructor create_list;
           Procedure add_to_list(p_itemT);
           Function f_item(p_indexInteger): T;
           Destructor DestroyOverride;
         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_itemT);
  Begin
    m_c_list.Add(p_item);
  End// add_to_list

Function c_list<T>.f_item(p_indexInteger): 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_listc_list<Integer>= Nil;

    Procedure TForm1.implementing_class_Click(SenderTObject);
      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(SenderTObject);
      Var l_i_integer_listi_add_to_list<Integer>;
          l_indexInteger;
      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_indexf_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(tInterfacedObjecti_add_to_list<Integer>)
           m_item_integer_arrayArray Of Integer;
           m_sequence_indexInteger;

           Constructor create_integer_array;
           Procedure add_to_list(p_itemInteger);
           Function f_item(p_indexInteger): Integer;
           Destructor DestroyOverride;
         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_itemInteger);
  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_indexInteger): 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(SenderTObject);
  Var l_indexInteger;
  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_indexf_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_subjectInterface// forward

             i_observer=
                 Interface
                   ['{92DA1578-996E-4E3A-965C-CCDDB1F30CC8}']
                   Procedure update_observer(p_i_subjecti_subject);
                 End// i_observer

             i_subject=
                 Interface
                   ['{D53BC8BB-E7B8-437B-99A7-6EBF7D5F2309}']
                   Procedure add_observer(p_i_observeri_observer);
                   Procedure remove_observer(p_i_observeri_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 Classesu_i_subject_observer;

        Type c_subject=
                 Class(TInterfacedObjecti_subject)
                   Private
                     m_c_observer_listTInterfaceList;

                     // -- a reference to the final subject, to be able
                     // -- to send it to the observers when sends notifications
                     m_i_subject_refi_subject;
                   Public

                     Constructor create_subject(p_i_subject_refi_subject);

                     // -- i_subject implementation
                     Procedure add_observer(p_i_observeri_observer);
                     Procedure remove_observer(p_i_observeri_observer);
                     Procedure notify_observers;

                     Destructor DestroyOverride;
                 End// c_subject

      Implementation

        // -- c_subject

        Constructor c_subject.create_subject(p_i_subject_refi_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_observeri_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_observeri_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_indexinteger;
          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_temperatureinteger;
                   Function f_humidityinteger;
                 End// i_meteo

             c_meteo_subject_2=
                 Class(c_subjecti_meteo)
                   m_temperatureinteger;
                   m_humidityinteger;

                   m_c_timerTTimer;

                   Constructor create_meteo_subject;
                   Procedure handle_timer_event(SenderTObject);

                   Function f_temperatureinteger;
                   Function f_humidityinteger;

                   Destructor destroyOverride;
                 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_temperatureinteger;
          Begin
            Result:= m_temperature;
          End// f_temperature

        Function c_meteo_subject_2.f_humidityinteger;
          Begin
            Result:= m_humidity;
          End// f_humidity

        Procedure c_meteo_subject_2.handle_timer_event(SenderTObject);
          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(TFormi_observer)
                   Memo1TMemo;
                   create_meteo_TButton;
                 Private
                   Procedure update_observer(p_i_subjecti_subject);
                 Public
                 End// tForm1

          Var
            Form1TForm1;

          Implementation
            Uses u_display_simple
                , u_c_subject
                , u_c_meteo_subject_2
                ;

        {$R *.dfm}

        Var g_c_meteoc_meteo_subject_2Nil;

        Procedure TForm1.update_observer(p_i_subjecti_subject);
          Var l_i_meteoi_meteo;
          Begin
            l_i_meteo:= p_i_subject As i_meteo;
            display(Format('temp %5d %5d',
                [g_c_meteo.m_temperaturel_i_meteo.f_temperature]));
          End// update_observer

        Procedure TForm1.create_meteo_Click(SenderTObject);
          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_subjectS);
                 End// i_observer

             i_subject<S>=
                 Interface
                   ['{D53BC8BB-E7B8-437B-99A7-6EBF7D5F2309}']
                   Procedure add_observer(p_i_observeri_observer<S>);
                   Procedure remove_observer(p_i_observeri_observer<S>);
                   Procedure notify_observers;
                 End// i_subject

      Implementation

        End

  • la Class c_subject

    Unit u_c_generic_subject;
      Interface
        Uses ClassesGenerics.Collections
            , u_i_generic_subject_observer
            ;

        Type c_subject<S>=
                 Class(TInterfacedObjecti_subject<S> )
                   Private
                     m_c_observer_listtListi_observer<S> >;

                     m_c_subject_refS;
                   Public
                     Constructor create_subject(p_c_subject_refS);

                     // -- i_subject implementation
                     Procedure add_observer(p_i_observeri_observer<S>);
                     Procedure remove_observer(p_i_observeri_observer<S>);
                     Procedure notify_observers;

                     Destructor DestroyOverride;
                 End// c_subject

      Implementation

        // -- c_subject

        Constructor c_subject<S>.create_subject(p_c_subject_refS);
          Begin
            Inherited Create;

            m_c_observer_list:= tListi_observer<S> >.Create;

            m_c_subject_ref:= p_c_subject_ref;
          End// create_subject

        Procedure c_subject<S>.add_observer(p_i_observeri_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_observeri_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_indexinteger;
          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_temperatureinteger;
                     m_humidityinteger;

                     m_c_timerTTimer;
                   Public
                     Constructor create_meteo_subject;

                     Procedure handle_timer_event(SenderTObject);

                     Function f_temperatureinteger;
                     Function f_humidityinteger;

                     Destructor destroyOverride;
                 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_temperatureinteger;
          Begin
            Result:= m_temperature;
          End// f_temperature

        Function c_meteo.f_humidityinteger;
          Begin
            Result:= m_humidity;
          End// f_humidity

        Procedure c_meteo.handle_timer_event(SenderTObject);
          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(TFormi_observer<c_meteo>)
                     Memo1TMemo;
                     Procedure create_meteo_Click(SenderTObject);
                   Private
                     Procedure update_observer(p_c_subjectc_meteo);
                   Public
                 End;

        Var Form1TForm1;

      Implementation
        Uses u_display_simple;

        {$R *.dfm}

        Procedure TForm1.update_observer(p_c_subjectc_meteo);
          Begin
            display(Format('temp %5d',
                [p_c_subject.f_temperature]));
          End// update_observer

        Var g_c_meteoc_meteoNil;

        Procedure TForm1.create_meteo_Click(SenderTObject);
          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_Si_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_toT_equal): Boolean;
           Function f_displayString
         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_arrayArray Of T;
           Procedure add_item(p_itemT);
           Function f_indexof(p_itemT): Integer;
         End// c_item_list<T ...>

Procedure c_item_list<T>.add_item(p_itemT);
  Begin
    SetLength(m_arrayLength(m_array)+ 1);
    m_array[Length(m_array)- 1]:= p_item;
  End// add_item

Function c_item_list<T>.f_indexof(p_itemT): Integer;
  Var l_indexInteger;
  Begin
    For l_index := 0 To Length(m_array) - 1 Do
    Begin
      display(Format('%2d  %s', [l_indexm_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(tInterfacedObjecti_equal_to<c_person>)
           m_firstnameString;
           Constructor create_person(p_firstnameString);
           Function f_equal_to(p_i_equal_toc_person): Boolean;
           Function f_displayString;
         End// c_cell

Constructor c_person.create_person(p_firstnameString);
  Begin
    m_firstname:= p_firstname;
  End// create_person

Function c_person.f_displayString;
  Begin
    Result:= m_firstname;
  End// f_display

Function c_person.f_equal_to(p_i_equal_toc_person): Boolean;
  Begin
    Result:= m_firstnamep_i_equal_to.m_firstname;
  End// f_equal_to

// -- using

Procedure TForm1.indexof_Click(SenderTObject);
  Var l_indexofInteger;
      l_c_target_personc_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_onep_c_twoT): Boolean;
           Function f_display(p_c_TT): String;
         End;

     c_item_list =
         Class(tInterfacedObjecti_equal_to<c_person>)
           m_arrayArray Of c_person;

           // -- i_equal_to
           Function f_are_equal(p_c_onep_c_twoc_person): Boolean;
           Function f_display(p_c_Tc_person): String;

           Procedure add_item(p_itemc_person);
           Function f_indexof(p_itemc_person): Integer;
         End// c_item_list

avec l'utilisation suivante

Procedure TForm1.person_list_Click(SenderTObject);
  Var l_indexofInteger;
      l_c_target_personc_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 <TClass> =
         Class
           Private
             m_c_dataT;
           Public
             Constructor create_data_container(p_c_dataT);

             Procedure display_data;
             Function ToStringStringOverride;

             Destructor DestroyOverride;
           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_dataThen
    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>.ToStringString;
  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(SenderTObject);
  Var l_c_personc_person;
  Begin
    l_c_person:= c_person.create_person('Miller', 44);

    With c_data_container<c_person>.create_data_container(l_c_personDo
    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(SenderTObject);
  Var l_c_personc_person;
  Begin
    l_c_person:= c_person.create_person('Miller', 44);

    With c_data_container<c_person>.create_data_container(l_c_personDo
    Begin
      display_data;
      display(ToString);
      Free;
    End// with c_data_container
  End// data_container_Click

et son utilisation:

Var g_c_wincontrol_listc_wincontrol_list<tWinControl> ;

Procedure TForm1.create_control_list_Click(SenderTObject);
  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(SenderTObject);
  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_factoryTClassConstructor >=
             Class
               m_c_dictionaryTDictionarystringtClass> ;

               Constructor create_object_factory;
               Procedure register_class<U>;
               Function f_c_instance(p_class_namestring): T;
               Destructor DestroyOverride;
             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:= TDictionarystringtClass>.Create;
      End// create_object_factory

    Procedure c_object_factory<T>.register_class<U>;
      Var l_pt_type_infoPTypeInfo;
          l_class_typetClass;
      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.Namel_class_type.ClassName]));
        m_c_dictionary.Add(l_pt_type_info.Namel_class_type);
      End// register_class<U>

    Function c_object_factory<T>.f_c_instance(p_class_namestring): T;
      Var l_T_classtClass;
      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_factoryc_object_factory<c_ancestor>= Nil;

    Procedure TForm1.create_factory_list_Click(SenderTObject);
      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(SenderTObject);
      Var l_c_ac_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) :

  • tout d'abord nous définissons les calculateurs de base

    Type c_calculator<T>=
             Class
               Function f_multiply(p_onep_twoT): TVirtualAbstract;
             End// compute

         c_integer_calculator=
             Class(c_calculator<Integer>)
               Function f_multiply(p_onep_twoInteger): IntegerOverride;
             End// c_integer_calculator
         c_double_calculator=
             Class(c_calculator<Double>)
               Function f_multiply(p_onep_twoDouble): DoubleOverride;
             End// c_double_calculator
         c_string_calculator=
             Class(c_calculator<string>)
               Function f_multiply(p_onep_twostring): stringOverride;
             End// c_string_calculator

    avec des implémentation évidentes (plus les autre opérations, addition, soustraction etc)

  • notre computer générique est défini ainsi:

    Type c_computer<TCc_calculator<T>, Constructor>=
             Class(c_calculator<T>)
               Function f_do_multiply(p_onep_twoT): T;
             End// c_computer<T>

    Function c_computer<TC>.f_do_multiply(p_onep_twoT): T;
      Var l_c_calculatorC;
      Begin
        l_c_calculator:= C.create;
        Try
          Result:= l_c_calculator.f_multiply(p_onep_two);
        Finally
          l_c_calculator.Free;
        End;
      End// f_do_multiply

    • le paramètre C est contraint à être l'un de nos calculateurs spécifiques
    • la contrainte Constructor nous permet d'instancier ce calculateur précis pour faire l'opération sur ce type
  • et voici une utilisation :

    Procedure TForm1.multiply_integers_Click(SenderTObject);
      Var l_c_integer_computerc_computer<Integerc_integer_calculator>;
          l_resultInteger;
      Begin
        l_c_integer_computer:= c_computer<Integerc_integer_calculator>.Create;
        Try
          l_result:= l_c_integer_computer.f_do_multiply(3, 4);
          display('3* 4= 'IntToStr(l_result));
        Finally
          l_c_integer_computer.Free;
        End// try ... except
      End// multiply_integers_Click




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 :

image



Voici un exemple simple de tri d'une tList<c_person>:

Type c_person_comparer=
         Class(tComparer<c_person>)
           Function Compare(Const LeftRightc_person): IntegerOverride;
         End;

Function c_person_comparer.Compare(Const LeftRightc_person): Integer;
  Begin
    If Left.m_first_nameRight.m_first_name
      Then Result:= -1
      Else
        If Left.m_first_nameRight.m_first_name
          Then Result:= 1
          Else Result:= 0;
  End// Compare

Var g_c_person_listtList<c_person>= Nil;

Procedure TForm1.sort_person_list_Click(SenderTObject);
  Var l_i_comparerIComparer<c_person>;
      l_c_personc_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.Sortl_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

02_enumerator



Notez que

  • dans SYSTEM.PAS il existe bien des iEnumerable, iEnumerator, iComparable, iEquatable :

    04_ienumerable

    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" :
    Nom :
    E-mail :
    Commentaires * :
     

  • 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 génériques et les anonymes sont présentés dans nos formations Delphi:
  • Formation Delphi Xe3 Complète : maîtriser Delphi XE3 : 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 Xe3 : 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.
Créé: feb-13. Maj: aou-15  148 articles, 471 sources .ZIP, 2.021 figures
Contact : John COLIBRI - Tel: 01.42.83.69.36 / 06.87.88.23.91 - email:jcolibri@jcolibri.com
Copyright © J.Colibri   http://www.jcolibri.com - 2001 - 2015
Retour:  Home  Articles  Formations  Développement Delphi  Livres  Pascalissime  Liens  Download
l'Institut Pascal

John COLIBRI

+ Home
  + articles_avec_sources
    + bases_de_donnees
    + web_internet_sockets
    + prog_objet_composants
      – dump_interface
      – packages_delphi
      – ecriture_de_composant
      – c_list_of_double
      – interfaces_delphi
      – delphi_generics
      – delphi_rtti
    + office_com_automation
    + colibri_utilities
    + uml_design_patterns
    + graphique
    + delphi
    + outils
    + firemonkey
    + vcl_rtl
    + colibri_helpers
    + colibri_skelettons
  + formations
  + developpement_delphi
  + présentations
  + pascalissime
  + livres
  + entre_nous
  – télécharger

contacts
plan_du_site
– chercher :

RSS feed  
Blog

Migration Delphi migration de versions Delphi, migration Unicode, migration BDE / base de données, migration Internet - Tél 01.42.83.69.36
Formation Bases de Données Interbase / Firebird Gestion de bases de données : les composants Ibx, connexion, accès aux tables, édition d'états - 3 jours
Formation de Delphi 7 à Xe3 Présentation des nouveautés de Delphi 5, 6, 7 à Delphi Xe, Xe2, Xe3: nouveautés Rtl (génériques, anonymes, RTTI), Vcl (LiveBindings, FireMonkey, Mobiles), outil - 5 jours
Formation UML et Design Patterns Delphi Analyse et Conception Delphi en utilisant UML et les Design Patterns - 3 jours