|
c_list_of_double - John COLIBRI. |
- résumé : encapsulation de liste de valeurs réelles, en utilisant des ARRAY OF, des tList de ^Double et des tList de c_double
- mots clé : liste de doubles - encapsulation - techniques objet - tList - série numérique - Vecteur - calcul matriciel - New - pointeurs
- logiciel utilisé : Windows XP personnel, Delphi 6.0
- matériel utilisé : Pentium 2.800 Mhz, 512 Meg de mémoire, 250 Giga disque dur
- champ d'application : Delphi 5, Delphi 6, Delphi 6, Delphi 6, Delphi 2006, Turbo Delphi, Delphi 2007 sur Windows
- niveau : développeur Delphi
- plan :
1 - Liste de Réels
Pour réaliser des traitements scientifiques, il est fréquent d'avoir à utiliser des tableaux ou des liste de réels, en général de type Double. Lorsque la taille de la série est inconnue à la compilation, il faut armer un
série pouvant être dimensionnée, ou redimensionnée par l'utilisateur. Nous allons présenter ici une CLASS Delphi et d'autres techniques de programmation Objet Delphi permettant cette encapsulation de listes de valeurs numériques.
2 - Encapsulation de liste de Double 2.1 - Les techniques Standard Si nous connaissons la taille de la série à utiliser, par exemple 1000 ou 1024 points, nous pouvons utiliser:
|
VAR tableau: ARRAY[0..999] OF Double |
Ici, c'est le programmeur Delphi qui a figé la taille du tableau. Cela fonctionne parfaitement si l'utilisateur a exactement besoin de 1000 Doubles. En revanche, si l'utilisateur a besoin de 10 Doubles, il en a 990 de trop, et
s'il en a besoin de 1200, il lui en manque 200. Depuis Delphi 2, nous pouvons utiliser des tableaux dynamiques, ou c'est l'utilisateur qui peut indiquer quelle taille de tableau il souhaite utiliser:
- nous déclarons une ARRAY OF (sans donner les bornes initiales et finales du tableau):
|
VAR tableau_dynamique: ARRAY OF Double |
Ceci peut être représenté par le schéma suivant: - nous demandons à l'utilisateur de fournir la taille. Il tape par exemple
cette taille dans un tEdit, et nous dimensionnons le tableau dans un tButton.OnClick:
l_taille:= IntToStr(Edit1.Text);
SetLength(tableau_dynamique, l_taille);
| Supposons que l'utilisateur demande 3 cellules. Delphi alloue les 3
cellules: - l'utilisateur ajoute ses valeurs dans le tableau, exactement comme pour un tableau statique:
tableau_dynamique[0]:= 3.14;
tableau_dynamique[1]:= -45.67;
| soit:
- s'il change d'avis, et modifie la taille du tableau, Delphi redimensionne le tableau. Supposons que l'utilisateur décide d'agrandir son tableau à 7
cellules. Pour cela, il exécute simplement la même instruction SetLength avec la même valeur:
SetLength(tableau_dynamique, 7);
| et l'allocateur mémoire de Delphi va:
- chercher en mémoire un espace assez grand pour contenir nos 7 cellules, et va le réserver en le remplissant de 0
- il va copier les valeurs du tableau actuel au début de la nouvelle zone:
- il va faire pointer notre variable tableau_dynamique vers la nouvelle
zone et rendre l'ancienne zone (de 3 cellules) au système
- la fonction Length permet à chaque instant de connaître la taille. Par
exemple, un développeur prudent vérifiera que l'utilisateur n'essaye pas de lire ou écrire un zone en dehors du tableau:
IF indice< Length(tableau_dynamique)
THEN tableau_dynamique[indice]:= valeur
ELSE ShowMessage('débordement d''indice');
|
- et finalement, lorsque nous souhaitons libérer la mémoire contenant les cellules, nous affectons simplement NIL au tableau:
Notez que: - un ARRAY OF correspond à un pointeur, et SetLength alloue les données
contenues dans le tableau. Mais le compilateur gère cette allocation, et lorsque nous souhaitons accéder aux données, nous n'avons pas besoin d'utiliser le symbole ^
- de plus l'allocation / libération est réalisée en utilisant SetLength et l'affectation de NIL (et non pas via NEW et DISPOSE, comme pour les pointeurs ordinaires)
Nous constatons alors que nous disposons bien de toutes les fonctionnalités pour gérer des tableaux de n'importe quelle taille. Toutefois, cela nous oblige à truffer notre code utilisateur de nombreux tests et appels à des routines de
gestion des tableaux dynamiques. En fait, vu du point de vue de 'utilisateur, tout ce qu'il souhaite est - créer son tableau
- ajouter quelques valeur, et ceci sans provoquer d'erreur de débordement
- pouvoir accéder aux valeurs de son tableau pour modifier des valeurs, ou les lire, avec la syntaxe la plus légère possible.
Compte tenu de cet énoncé du problème, la solution pour un développeur Delphi
est instantannée: il faut créer une CLASS qui encapsule nos instructions Delphi et représente un liste de Double.
2.2 - La première CLASSe encapsulant un ARRAY OF Double
Voici la définition de notre CLASS c_double_list:
c_array_of_double= Class
m_array_of_double: ARRAY of Double;
m_count: Integer;
Constructor create;
procedure add_double(p_double: Double);
function f_double(p_index: Integer): Double;
Destructor Destroy; Override;
end; // c_array_of_double
|
et: - m_array_of_double contiendra, comme ci-dessus, les Doubles
- le CONSTRUCTOR va initialiser la CLASS
- add_double permet d'ajouter des valeurs au tableau
- f_double récupère une valeur
Et voici les procédures correspondantes:
Constructor c_array_of_double.create;
begin
InHerited Create;
end; // create
procedure c_array_of_double.add_double(p_double: Double);
begin
if m_count>= Length(m_array_of_double)
then
if Length(m_array_of_double)= 0
then SetLength(m_array_of_double, 1)
else SetLength(m_array_of_double, 2* Length(m_array_of_double));
m_array_of_double[m_count]:= p_double;
Inc(m_count);
end; // add_double
function c_array_of_double.f_double(p_index: Integer): Double;
begin
if p_index>= Length(m_array_of_double)
then Raise Exception.Create('p_index> m_count');
Result:= m_array_of_double[p_index];
end; // f_double
Destructor c_array_of_double.destroy;
begin
m_array_of_double:= Nil;
Inherited;
end; // destroy
|
Et voici un exemple de programme utilisant notre CLASSe:
var g_c_array_of_double: c_array_of_double= Nil;
procedure TForm1.create_arrayClick(Sender: TObject);
begin
g_c_array_of_double:= c_array_of_double.Create;
end; // create_arrayClick
procedure TForm1.add_doublesClick(Sender: TObject);
begin
if g_c_array_of_double= Nil
then g_c_array_of_double.Create;
g_c_array_of_double.add_double(1.1);
g_c_array_of_double.add_double(2.2);
g_c_array_of_double.add_double(3.3);
g_c_array_of_double.add_double(4.4);
end; // add_doubles_Click
procedure TForm1.display_doublesClick(Sender: TObject);
var l_index: Integer;
begin
for l_index:= 0 to g_c_array_of_double.m_count- 1 do
Memo1.Lines.Add(FloatToStr(g_c_array_of_double.f_double(l_index)));
end; // display_doubles_Click
procedure TForm1.free_doubleClick(Sender: TObject);
begin
g_c_array_of_double.Free;
g_c_array_of_double:= Nil;
// or : FreeAndNil(g_c_array_of_double);
end; // free_double_Click
|
Notez que: - nous n'avons pas donné de dimension initiale à notre tableau. La première
addition se chargera de donner la taille qu'il faut à notre tableau
- notre encapsulation est loin d'être parfaite: l'utilisateur doit encore accéder à g_c_array_of_double.m_array_of_double, et utiliser
g_c_array_of_double.m_count
Pour mieux rendre notre représentation opaque à l'utilisateur, nous allons - créer une PROPERTY Doubles et les deux méthodes set_double et
get_double correspondantes
- créer une PROPERTY Count
Voici alors la nouvelle CLASSe: - sa définition:
const k_granularity= 4;
type c_array_of_double_2=
Class
private
m_array_of_double: ARRAY of Double;
m_count: Integer;
function get_double(p_index: Integer): Double;
procedure set_double(p_index: Integer; p_double: Double);
public
Constructor create;
procedure add_double(p_double: Double);
procedure set_length(p_length: Integer);
Destructor Destroy; Override;
Property Doubles[p_index: Integer] : Double
read get_double write set_double; Default;
Property Count: Integer read m_count write m_count;
end; // c_array_of_double
| - son implémentation
Constructor c_array_of_double_2.create;
begin
InHerited Create;
SetLength(m_array_of_double, k_granularity);
end; // create
procedure c_array_of_double_2.add_double(p_double: Double);
begin
if m_count>= Length(m_array_of_double)
then SetLength(m_array_of_double, 2* Length(m_array_of_double));
m_array_of_double[m_count]:= p_double;
Inc(m_count);
end; // add_double
function c_array_of_double_2.get_double(p_index: Integer): Double;
begin
if p_index>= Length(m_array_of_double)
then Raise Exception.Create('p_index> m_count');
Result:= m_array_of_double[p_index];
end; // get_double
procedure c_array_of_double_2.set_double(p_index: Integer; p_double: Double);
begin
if p_index>= Length(m_array_of_double)
then begin
m_count:= p_index+ 1;
SetLength(m_array_of_double, m_count);
end;
m_array_of_double[p_index]:= p_double;
end; // set_double
procedure c_array_of_double_2.set_length(p_length: Integer);
begin
m_array_of_double:= Nil;
m_count:= p_length;
SetLength(m_array_of_double, m_count);
end; // set_length
Destructor c_array_of_double_2.destroy;
begin
m_array_of_double:= Nil;
Inherited;
end; // destroy
| - et un exemple d'utilisation:
var g_c_array_of_double_2: c_array_of_double_2= Nil;
procedure TForm1.create_array_2Click(Sender: TObject);
begin
g_c_array_of_double_2:= c_array_of_double_2.Create;
end; // create_array_2Click
procedure TForm1.add_doubles_2Click(Sender: TObject);
begin
g_c_array_of_double_2.set_length(4);
g_c_array_of_double_2[0]:= 10.0;
g_c_array_of_double_2[1]:= 20.0;
g_c_array_of_double_2[2]:= 40.0;
g_c_array_of_double_2[3]:= 40.0;
g_c_array_of_double_2[4]:= 50.0;
g_c_array_of_double_2[5]:= 60.0;
end; // add_doubles_2Click
procedure TForm1.display_double_2Click(Sender: TObject);
var l_index: Integer;
begin
Memo1.Lines.Add('nombre '+ IntToStr(g_c_array_of_double_2.Count));
for l_index:= 0 to g_c_array_of_double_2.Count- 1 do
Memo1.Lines.Add(FloatToStr(g_c_array_of_double_2[l_index]));
end; // display_double_2Click
procedure TForm1.free_double_2Click(Sender: TObject);
begin
FreeAndNil(g_c_array_of_double_2);
end; // free_double_2Click
|
Et voici l'image de notre application complète:
Notez que: - dans cet exemple nous avons commencé par donner une taille initiale dans le
CONSTRUCTOR (4 dans notre cas). Une autre possibilité encore aurait été de doter le CONSTRUCTOR d'un paramètre p_taille_initiale
- pour redimensionner le tableau
- nous vérifions à chaque utilisation d'un indice, que celui-ci est bien dans la plage des valeurs actuellement permises. Si ce n'est pas le cas, nous redimensionnons automatiquement le tableau
- pour redimensionner le tableau, plusieurs stratégies sont possibles:
- soit augmenter le tableau d'une cellule à la fois. Il a 3 cellules, l'utilisateur en veut une de plus, eh bien nous en allouons une de
plus et il a a présent un tableau de 4 cellules, puis 5 cellules
- soit augmenter d'une quantité fixe. Par exemple 10 ou 16. Dans notre
exemple, si nous augmentons de 2, il a 3 au départ, puis 5, 7, 9 etc:
- soit utiliser le système "Buddy-Buddy" qui consiste à doubler la
taille à chaque réallocation. Nous commençons par exemple à 3, puis augmentons à 6, 12, 24 etc.
Dans les deux derniers cas, il faut gérer deux variables
- la taille allouée (fournie par Length())
- le nombre de cellules actuellement utilisées, contenu dans m_count
- nous avons aussi décidé de laisser l'utilisateur taper n'importe que indice,
en allouant au besoin ce qu'il faut entre la taille actuelle du tableau et la cellule demandée par l'utilisateur. Par exemple:
- la taille actuelle est de 23
- l'utilisateur veut modifier la cellule 34
- nous allons les cellules entre 24 et 32 en les remplissant de 0
Cette stratégie est astucieuse, mais, en fonction du problème à traiter peut être risquée. Par exemple, si l'utilisateur se trompe et tape 110 au lieu de
10, notre CLASS lui fournira, sans rien lui dire, un tableau plus grand qu'il ne le souhaitait. Plusieurs solutions si vous souhaitez éviter ces redimensionnements automatiques:
- tester l'indice demandé, et provoquer une exception si l'utilisateur dépasse la limite qu'il a initialement demandé
- forcer le dimensionnement lors de l'appel du CONSTRUCTOR, et ne pas redimensionner par la suite
2.3 - Utilisation d'une tList de ^Double Au lieu d'utiliser un ARRAY OF Double, nous pouvons utiliser une tList, qui a l'avantage essentiel que c'est Delphi qui se charge de l'allocation /
réallocation des cellules. Nous appelons simplement tList.Add(xxx) et cette instruction ajoute une nouvelle cellule. En fait, la tList utilise un mécanisme similaire au nôtre:
- lors de la création, une table de 16 cellules est allouée (c'est la Granularity de la tList), et Count est égal à 0
- lorsque nous appelons Add :
- si Count est inférieur à la taille allouée, la valeur est placée après la dernière valeur utilisée
- dans le cas contraire, la taille allouée est doublée (système Buddy-Buddy) et la valeur est placée après la dernière valeur utilisée
Le seul problème est que la table de données utilisée, appelée tList.Items, n'est pas prévue pour contenir des Doubles, mais de Pointer: un pointeur générique, de taille 4 octets.
Il nous faut donc placer chaque Double dans une autre cellule, associée à la cellule courante. Nous pouvons utiliser deux techniques: - utiliser des pointeurs de Double, et stocker nos doubles dans chaque cellule pointée
- utiliser une CLASS c_double qui contiendra nos doubles
Commençons par la première technique Pour cela:
Notez:
A présent, voici donc une CLASS qui a exactement la même fonctionnalité que la CLASS précédente, mais qui utilise des pointeurs de Double: - voici la définition de la CLASSe:
type t_pt_double= ^Double;
c_tlist_of_pt_double=
Class(tList)
Private
function get_double(p_index: Integer): Double;
procedure set_double(p_index: Integer; p_double: Double);
Public
Constructor create;
procedure add_double(p_double: Double);
Destructor Destroy; Override;
Property Doubles[p_index: Integer] : Double
Read get_double Write set_double; Default;
end; // c_tlist_of_pt_double
| - et son implémentation:
Constructor c_tlist_of_pt_double.create;
begin
Inherited Create;
end; // create
procedure c_tlist_of_pt_double.add_double(p_double: Double);
var l_pt_double: t_pt_double;
begin
New(l_pt_double);
l_pt_double^:= p_double;
Inherited Add(l_pt_double);
end; // add_double
function c_tlist_of_pt_double.get_double(p_index: Integer): Double;
var l_pt_double: t_pt_double;
begin
if p_index>= Count
then Raise Exception.Create('p_index> m_count');
Result:= t_pt_double(Items[p_index])^;
end; // get_double
procedure c_tlist_of_pt_double.set_double(p_index: Integer; p_double: Double);
var l_index: Integer;
begin
// -- if index beyond Count, create with 0 filled cells
if p_index>= Count
then
For l_index:= Count to p_index do
add_double(0);
t_pt_double(Items[p_index])^:= p_double;
end; // set_double
Destructor c_tlist_of_pt_double.destroy;
var l_index: Integer;
begin
for l_index:= 0 To Count- 1 do
Dispose(Items[l_index]);
Inherited;
end; // destroy
| - en prime, un exemple d'utilisation:
var g_c_tlist_of_pt_double: c_tlist_of_pt_double= Nil;
procedure TForm1.create_listClick(Sender: TObject);
begin
g_c_tlist_of_pt_double:= c_tlist_of_pt_double.Create;
end; // create_arrayClick
procedure TForm1.add_doublesClick(Sender: TObject);
begin
if g_c_tlist_of_pt_double= Nil
then g_c_tlist_of_pt_double.Create;
g_c_tlist_of_pt_double.add_double(1.1);
g_c_tlist_of_pt_double.add_double(2.2);
g_c_tlist_of_pt_double.add_double(3.3);
g_c_tlist_of_pt_double.add_double(4.4);
end; // add_doubles_Click
procedure TForm1.display_doublesClick(Sender: TObject);
var l_index: Integer;
begin
for l_index:= 0 to g_c_tlist_of_pt_double.Count- 1 do
Memo1.Lines.Add(FloatToStr(g_c_tlist_of_pt_double.Doubles[l_index]));
end; // display_doubles_Click
procedure TForm1.free_listClick(Sender: TObject);
begin
FreeAndNil(g_c_tlist_of_pt_double);
end; // free_double_Click
procedure TForm1.set_4_directClick(Sender: TObject);
begin
if g_c_tlist_of_pt_double= Nil
then g_c_tlist_of_pt_double.Create;
g_c_tlist_of_pt_double.Doubles[3]:= 4.4;
end; // set_4_directClick
|
qui se présente ainsi: 
Notez que
- nous avons choisi de conserver add_double. Il aurait été possible d'utiliser Add, qui est plus traditionnel
- si nous utilisons Add, il est impératif d'appeler INHERITED Add pour
ajouter le pointeur dans la liste (INHERITED n'aurait pas été nécessaire avec add_double, car la tList n'a aucune méthode ayant ce nom)
- nous avons choisi d'hériter de tList. Il aurait été possible de placer dans
une c_tlist_of_pt_double un attribut m_c_tlist de type tList (comme nous avions inclus un attribut m_array_of_double dans la CLASS précédente). L'avantage de l'héritage est de bénéficier directement des propriétés et
méthodes de la tList (Count, Find etc). Si la tList est incluse (composition plutôt qu'héritage), il faut créer des PROPERTYes qui relaient les mêmes propriétés de la tList. Dans notre cas, l'héritage
semble avantageux. En revanche si nous souhaitons utiliser plusieurs tList (voir plus loin), nous n'aurons pas d'autre choix que de placer les tList dans la CLASSe
Cette technique est certes utilisable, mais reste un peu étrange pour les nouveaux venus dans Delphi qui préféreraient éviter les pointeurs, qui ont, à cause de leur utilisation un peu délicate, une mauvaise réputation.
Nous pouvons donc effectuer le même traitement en créant un objet dont la seule vocation sera de contenir notre valeur Double
2.4 - Une tList de c_double
Pour éviter les New et Dispose (qui fonctionnent parfaitement), nous pouvons utiliser une CLASS spéciale pour stocker chaque Double. Donc: - voici la définition des deux CLASSes:
type c_double=
Class
m_double: Double;
Constructor create(p_double: Double);
end; // c_double
c_tlist_of_c_double=
Class(tList)
Private
function get_double(p_index: Integer): Double;
procedure set_double(p_index: Integer; p_double: Double);
Public
Constructor create;
procedure add_double(p_double: Double);
Destructor Destroy; Override;
Property Doubles[p_index: Integer] : Double
Read get_double Write set_double; Default;
end; // c_tlist_of_c_double
| - et leur implémentation:
// -- c_double
Constructor c_double.create(p_double: Double);
begin
Inherited Create;
m_double:= p_double;
end; // create
// -- c_tlist_of_c_double.
Constructor c_tlist_of_c_double.create;
begin
Inherited Create;
end; // create
procedure c_tlist_of_c_double.add_double(p_double: Double);
begin
Inherited Add(c_double.create(p_double))
end; // add_double
function c_tlist_of_c_double.get_double(p_index: Integer): Double;
begin
if p_index>= Count
then Raise Exception.Create('p_index> m_count');
Result:= c_double(Items[p_index]).m_double;
end; // get_double
procedure c_tlist_of_c_double.set_double(p_index: Integer; p_double: Double);
var l_index: Integer;
begin
// -- if index beyond Count, create with 0 filled cells
if p_index>= Count
then
For l_index:= Count to p_index do
add_double(0);
c_double(Items[p_index]).m_double:= p_double;
end; // set_double
Destructor c_tlist_of_c_double.destroy;
var l_index: Integer;
begin
for l_index:= 0 To Count- 1 do
c_double(Items[l_index]).Free;
Inherited;
end; // destroy
| - et le projet Delphi de test:
var g_c_tlist_of_c_double: c_tlist_of_c_double= Nil;
procedure TForm1.create_listClick(Sender: TObject);
begin
g_c_tlist_of_c_double:= c_tlist_of_c_double.Create;
end; // create_arrayClick
procedure TForm1.add_doublesClick(Sender: TObject);
begin
if g_c_tlist_of_c_double= Nil
then g_c_tlist_of_c_double.Create;
g_c_tlist_of_c_double.add_double(1.1);
g_c_tlist_of_c_double.add_double(2.2);
g_c_tlist_of_c_double.add_double(3.3);
g_c_tlist_of_c_double.add_double(4.4);
end; // add_doubles_Click
procedure TForm1.display_doublesClick(Sender: TObject);
var l_index: Integer;
begin
for l_index:= 0 to g_c_tlist_of_c_double.Count- 1 do
Memo1.Lines.Add(FloatToStr(g_c_tlist_of_c_double.Doubles[l_index]));
end; // display_doubles_Click
procedure TForm1.free_listClick(Sender: TObject);
begin
FreeAndNil(g_c_tlist_of_c_double);
end; // free_double_Click
| dont voici l'image: 
2.5 - Comparaison des trois techniques Nous pouvons facilement comparer les trois techniques par le schéma suivant:
Il en ressort que
- l'utilisation d'un ARRAY OF double est certainement la plus économe au niveau mémoire, et évite en plus tout surtypage
- l'emploi de pointeurs de Double est assez simple, mais nécessite une
allocation séparée pour chaque cellule, ce qui peut se révéler coûteux en temps. De plus il faut surtyper les éléments de la tList, au départ prévus pour contenir des Pointer et pas des Doubles^
- la création de CLASSe c_double est relativement classique. C'est la technique Delphi la plus naturelle, et elle est utilisée pour encapsuler dans une tList n'importe quel autre type de cellule (une c_string, une
c_ma_classe qui contiendrait de nombreux champs). Mais il faut savoir que chaque objet contient un certain nombre d'octets pour gérer les CLASSe: la taille de l'objet, le pointeur vers la VMT (table des méthodes virtuelles)
etc. D'où un consommation nettement supérieure par rapport à une cellule de Double. En revanche, si nous encapsulons un Double dans une CLASSe, nous pouvons y associer, si nous le souhaitons des méthodes qui seraient utiles
pour notre application: vérifier que la valeur est comprise entre certaines bornes, afficher avec certains formats prédéfinis, sauvegarder dans un flux, ou relire un flux etc
3 - Encapsulation de liste de Boolean Lorsque la taille de chaque élément est inférieur à la taille de la cellule
d'une tList (un Pointer, soit 4 octets), nous pouvons stocker la valeur dans chaque cellule en utilisant le surtypage. Schématiquement nous avons, pour nos trois structures canoniques:
Et, très rapidement, le code avec stockage dans les Pointer de la tList: - voici la définition de la CLASSe:
c_tlist_of_boolean=
Class(tList)
Private
function get_boolean(p_index: Integer): Boolean;
procedure set_boolean(p_index: Integer; p_boolean: Boolean);
Public
Constructor create;
procedure add_boolean(p_boolean: Boolean);
Destructor Destroy; Override;
Property Booleans[p_index: Integer] : Boolean
Read get_boolean Write set_boolean; Default;
end; // c_tlist_of_boolean
| - et leur implémentation:
Constructor c_tlist_of_boolean.create;
begin
Inherited;
end; // create
procedure c_tlist_of_boolean.add_boolean(p_boolean: Boolean);
begin
Inherited Add(Nil);
if p_boolean
then Items[Count- 1]:= Pointer(1);
end; // add_boolean
function c_tlist_of_boolean.get_boolean(p_index: Integer): Boolean;
begin
if p_index>= Count
then Raise Exception.Create('p_index> m_count');
Result:= Integer(Items[p_index])> 0;
end; // get_boolean
procedure c_tlist_of_boolean.set_boolean(p_index: Integer; p_boolean: Boolean);
var l_index: Integer;
begin
// -- if index beyond Count, create with 0 filled cells
if p_index>= Count
then
For l_index:= Count to p_index do
add_boolean(False);
if p_boolean
then Items[p_index]:= Pointer(1)
else Items[p_index]:= Nil;
end; // set_boolean
Destructor c_tlist_of_boolean.destroy;
begin
Inherited;
end; // destroy
| - et le résultat est:
Notez que - nous avons ici exploité que False a la valeur 0 (et donc NIL pour un
Pointer) et True la valeur 1
- l'exemple présenté peut être aisément adapté à des liste de Byte, ShortInt, SmallInt, Integer, Word, dWord, Char et WideChar, énuméré.
Bref, tout ce qui a moins de 4 octet
4 - Liste de Plusieurs Doubles 4.1 - Séries de plusieurs réels
Supposons à présent que nous souhaitions gérer des liste de plusieurs doubles: - les valeurs X, Y, Z d'un point en 3D
- les mesures électriques d'un composant (tension, intensité, fréquence etc)
- les données économiques d'une série (date, prix, volume pour une série boursière)
Dans ce cas, nous pouvons aussi mettre en place les mêmes alternatives:
- définir un RECORD ou une CLASSe pour chaque groupe de valeurs, et utiliser un ARRAY OF t_record ou c_class, et gérer nous-mêmes la réallocation. Cette solution fonctionne, mais nous perdons la seule
motivation que nous avions pour un Double, qui était d'éviter le surtypage
- utiliser une tList et placer les données dans un t_record^. Ici c'est à nouveau possible, mais en général, si déjà nous avons plusieurs valeurs à
gérer, il est plus que probable que nous aurons des traitements à réaliser sur chaque groupe de points (
- l'utilisation d'un CLASS c_class s révèle en général la plus adaptée
4.2 - ARRAY OF record_of_double ou record_of_double OF ARRAY OF Double En utilisant des tableaux dynamiques, ARRAY OF, nous avons deux solutions: - soit placer nos chaque valeur multidimensionnelle dans un RECORD et créer
un ARRAY OF de ces RECORDs
- soit créer un RECORD d'une c_array_of_double présenté ci-dessus
Schématiquement nous avons:
Pour la première solution:
- voici la définition des deux CLASSes:
type t_double_record= Record
m_x, m_y, m_z: Double;
end; // t_double_record
c_array_of_record_of_doubles=
Class
private
m_array_of_double_record: ARRAY of t_double_record;
m_count: Integer;
function get_doubles(p_index: Integer): t_double_record;
procedure set_doubles(p_index: Integer;
p_double_record: t_double_record);
function get_x(p_index: Integer): Double;
procedure set_x(p_index: Integer; p_x: Double);
function get_y(p_index: Integer): Double;
procedure set_y(p_index: Integer; p_y: Double);
function get_z(p_index: Integer): Double;
procedure set_z(p_index: Integer; p_z: Double);
public
Constructor create;
procedure add_doubles(p_double_record: t_double_record);
procedure set_length(p_length: Integer);
Destructor Destroy; Override;
Property Doubles[p_index: Integer] : t_double_record
Read get_doubles Write set_doubles; Default;
Property X[p_index: Integer] : Double
Read get_x Write set_x;
Property Y[p_index: Integer] : Double
Read get_y Write set_y;
Property Z[p_index: Integer] : Double
Read get_z Write set_z;
Property Count: Integer Read m_count Write m_count;
end; // c_array_of_double
function f_double_record(p_x, p_y, p_z: Double): t_double_record;
| - et leur implémentation:
function f_double_record(p_x, p_y, p_z: Double): t_double_record;
begin
Result.m_x:= p_x;
Result.m_y:= p_y;
Result.m_z:= p_z;
end; // f_double_record
// -- c_array_of_record_of_doubles
Constructor c_array_of_record_of_doubles.create;
begin
InHerited Create;
SetLength(m_array_of_double_record, k_granularity);
end; // create
procedure c_array_of_record_of_doubles.add_doubles(p_double_record: t_double_record);
begin
if m_count>= Length(m_array_of_double_record)
then SetLength(m_array_of_double_record, 2* Length(m_array_of_double_record));
m_array_of_double_record[m_count]:= p_double_record;
Inc(m_count);
end; // add_double
function c_array_of_record_of_doubles.get_doubles(p_index: Integer): t_double_record;
begin
if p_index>= Length(m_array_of_double_record)
then Raise Exception.Create('p_index> m_count');
Result:= m_array_of_double_record[p_index];
end; // get_doubles
procedure c_array_of_record_of_doubles.set_doubles(p_index: Integer; p_double_record: t_double_record);
begin
if p_index>= Length(m_array_of_double_record)
then begin
m_count:= p_index+ 1;
SetLength(m_array_of_double_record, m_count);
end;
m_array_of_double_record[p_index]:= p_double_record;
end; // set_doubles
function c_array_of_record_of_doubles.get_x(p_index: Integer): Double;
begin
Result:= Doubles[p_index].m_x;
end; // get_x
procedure c_array_of_record_of_doubles.set_x(p_index: Integer; p_x: Double);
begin
if p_index>= Length(m_array_of_double_record)
then begin
m_count:= p_index+ 1;
SetLength(m_array_of_double_record, m_count);
end;
m_array_of_double_record[p_index].m_x:= p_x;
end; // set_x
// -- ...ooo... idem for Y and Z
procedure c_array_of_record_of_doubles.set_length(p_length: Integer);
begin
m_array_of_double_record:= Nil;
m_count:= p_length;
SetLength(m_array_of_double_record, m_count);
end; // set_length
Destructor c_array_of_record_of_doubles.destroy;
begin
m_array_of_double_record:= Nil;
Inherited;
end; // destroy
| - et le projet Delphi de test:
var g_c_array_of_record_of_doubles: c_array_of_record_of_doubles= Nil;
procedure TForm1.create_arrayClick(Sender: TObject);
begin
g_c_array_of_record_of_doubles:= c_array_of_record_of_doubles.Create;
end; // create_arrayClick
procedure TForm1.add_doublesClick(Sender: TObject);
begin
if g_c_array_of_record_of_doubles= Nil
then g_c_array_of_record_of_doubles.Create;
g_c_array_of_record_of_doubles
.add_doubles(f_double_record(1.1, 2.2, 3.3));
g_c_array_of_record_of_doubles
.add_doubles(f_double_record(10.1, 20.2, 30.3));
g_c_array_of_record_of_doubles
.add_doubles(f_double_record(100.1, 200.2, 300.3));
// -- not allowed
// g_c_array_of_record_of_doubles.Doubles[3].m_x:= 3.14;
g_c_array_of_record_of_doubles.Doubles[3]:= f_double_record(3.14, 0, 0);
g_c_array_of_record_of_doubles.X[4]:= 6.28;
end; // add_doubles_Click
procedure TForm1.display_doublesClick(Sender: TObject);
var l_index: Integer;
begin
for l_index:= 0 to g_c_array_of_record_of_doubles.Count- 1 do
with g_c_array_of_record_of_doubles[l_index] do
display(Format('x = %5.2f, y =%5.1f, z =%5.1f ', [m_x, m_y, m_z]));
end; // display_doubles_Click
procedure TForm1.free_doubleClick(Sender: TObject);
begin
FreeAndNil(g_c_array_of_record_of_doubles);
end; // free_double_Click
| dont voici l'image: 
Notez que - nous avons ajouté une FUNCTION qui convertit trois Doubles isolés en un RECORD
- à notre grande surprise
g_c_array_of_record_of_doubles.Doubles[3].m_x:= 3.14;
|
n'est pas autorisé
Et pour la seconde solution - voici la définition du RECORD:
t_double_record= Record
m_c_x_array, m_c_y_array, m_c_z_array: c_array_of_double_2;
end; // t_double_record
|
- et le projet Delphi de test:
var g_c_record_of_array_of_doubles: t_double_record;
procedure TForm1.create_arraysClick(Sender: TObject);
begin
with g_c_record_of_array_of_doubles do
begin
m_c_x_array:= c_array_of_double_2.Create;
m_c_y_array:= c_array_of_double_2.Create;
m_c_z_array:= c_array_of_double_2.Create;
end; // with g_c_record_of_array_of_doubles
end; // create_array_2Click
procedure TForm1.add_doubles_2Click(Sender: TObject);
begin
with g_c_record_of_array_of_doubles do
begin
m_c_x_array[0]:= 1.1;
m_c_y_array[0]:= 2.2;
m_c_z_array[0]:= 3.3;
m_c_x_array[1]:= 10.1;
m_c_y_array[1]:= 20.2;
m_c_z_array[1]:= 30.3;
end; // with g_c_record_of_array_of_doubles
end; // add_double_property_Click
procedure TForm1.display_doubles_2Click(Sender: TObject);
var l_index: Integer;
begin
with g_c_record_of_array_of_doubles do
for l_index:= 0 to m_c_x_array.Count- 1 do
display(Format('x= %5.1f, y =%5.1f, z =%5.1f ',
[ m_c_x_array[l_index], m_c_y_array[l_index],
m_c_z_array[l_index] ]));
end; // display_double_property_Click
procedure TForm1.free_doubles_2Click(Sender: TObject);
begin
with g_c_record_of_array_of_doubles do
begin
FreeAndNil(m_c_x_array);
FreeAndNil(m_c_y_array);
FreeAndNil(m_c_z_array);
end; // with g_c_record_of_array_of_doubles
end; // free_double_2Click
| dont voici l'image: 
Notez que - dans la seconde solution, la définition est triviale, mais le code d'utilisation plus verbeux. Nous devrions en réalité utiliser un CLASS qui
encapsule les trois ARRAY OF Double. Donc une CLASS OF ARRAY OF Double
- la seconde solution permettrait aussi d'accomoder des séries de taille
différentes. Supposons que nous souhaitions modéliser des nombres et de leur valeur absolue distinctes. Voici le schéma:
4.3 - tList of pt_record_of_double Voici le traitement du même problème utilisant des pointeurs:
Pour la première solution: - voici les définitions:
type t_measure= Record
m_intensity, m_voltage, m_frequency: Double;
end; // t_measure
t_pt_measure= ^t_measure;
c_tlist_of_pt_doubles=
Class(tList)
Private
function get_measure(p_index: Integer): t_measure;
procedure set_measure(p_index: Integer; p_measure: t_measure);
function get_intensity(p_index: Integer): Double;
procedure set_intensity(p_index: Integer; p_intensity: Double);
Public
Constructor create;
procedure add_measure(p_measure: t_measure);
Destructor Destroy; Override;
Property Measure[p_index: Integer] : t_measure
Read get_measure Write set_measure; Default;
Property Intensity[p_index: Integer] : Double
Read get_intensity Write set_intensity;
end; // c_tlist_of_pt_doubles
function f_measure(p_intensity, p_voltage, p_frequency: Double): t_measure;
| - et leur implémentation:
function f_measure(p_intensity, p_voltage, p_frequency: Double): t_measure;
begin
Result.m_intensity:= p_intensity;
Result.m_voltage:= p_voltage;
Result.m_frequency:= p_frequency;
end; // f_measure
// -- c_tlist_of_pt_doubles
Constructor c_tlist_of_pt_doubles.create;
begin
Inherited Create;
end; // create
procedure c_tlist_of_pt_doubles.add_measure(p_measure: t_measure);
var l_pt_measure: t_pt_measure;
begin
New(l_pt_measure);
l_pt_measure^:= p_measure;
Inherited Add(l_pt_measure);
end; // add_measure
function c_tlist_of_pt_doubles.get_measure(p_index: Integer): t_measure;
var l_pt_measure: t_pt_measure;
begin
if p_index>= Count
then Raise Exception.Create('p_index> m_count');
Result:= t_pt_measure(Items[p_index])^;
end; // get_measure
procedure c_tlist_of_pt_doubles.set_measure(p_index: Integer;
p_measure: t_measure);
var l_index: Integer;
begin
// -- if index beyond Count, create with 0 filled cells
if p_index>= Count
then
For l_index:= Count to p_index do
add_measure(f_measure(0, 0, 0));
t_pt_measure(Items[p_index])^:= p_measure;
end; // set_measure
function c_tlist_of_pt_doubles.get_intensity(p_index: Integer): Double;
begin
if p_index>= Count
then Raise Exception.Create('p_index> m_count');
Result:= t_pt_measure(Items[p_index])^.m_intensity;
end; // get_intensity
procedure c_tlist_of_pt_doubles.set_intensity(p_index: Integer; p_intensity: Double);
var l_index: Integer;
begin
// -- if index beyond Count, create with 0 filled cells
if p_index>= Count
then
For l_index:= Count to p_index do
add_measure(f_measure(0, 0, 0));
t_pt_measure(Items[p_index])^.m_intensity:= p_intensity;
end; // set_intensity
Destructor c_tlist_of_pt_doubles.destroy;
var l_index: Integer;
begin
for l_index:= 0 To Count- 1 do
Dispose(Items[l_index]);
Inherited;
end; // destroy
| - ainsi que le projet Delphi de test:
var g_c_tlist_of_pt_doubles: c_tlist_of_pt_doubles= Nil;
procedure TForm1.create_listClick(Sender: TObject);
begin
g_c_tlist_of_pt_doubles:= c_tlist_of_pt_doubles.Create;
end; // create_arrayClick
procedure TForm1.add_doublesClick(Sender: TObject);
begin
if g_c_tlist_of_pt_doubles= Nil
then g_c_tlist_of_pt_doubles.Create;
g_c_tlist_of_pt_doubles.add_measure(f_measure(1.1, 2.2, 3.3));
g_c_tlist_of_pt_doubles.add_measure(f_measure(10.1, 20.2, 30.3));
g_c_tlist_of_pt_doubles.Measure[2]:= f_measure(3.14, 0, 0);
// -- ok if index< Count, but does not modify the value in the tList
with g_c_tlist_of_pt_doubles.Measure[2] do
begin
m_voltage:= 60.28;
display(Format('i =%5.1f, v =%5.1f, f =%5.1f',
[m_intensity, m_voltage, m_frequency]));
display_line;
end;
g_c_tlist_of_pt_doubles.Intensity[3]:= 9.42;
end; // add_doubles_Click
procedure TForm1.display_doublesClick(Sender: TObject);
var l_index: Integer;
l_measure: t_measure;
begin
for l_index:= 0 to g_c_tlist_of_pt_doubles.Count- 1 do
begin
(*
l_measure:= g_c_tlist_of_pt_doubles[l_index];
with l_measure do
display(Format('i =%5.1f, v =%5.1f, f =%5.1f',
[m_intensity, m_voltage, m_frequency]));
*)
with g_c_tlist_of_pt_doubles[l_index] do
display(Format('i =%5.1f, v =%5.1f, f =%5.1f',
[m_intensity, m_voltage, m_frequency]));
end; // for l_index
end; // display_doubles_Click
procedure TForm1.free_listClick(Sender: TObject);
begin
FreeAndNil(g_c_tlist_of_pt_doubles);
end; // free_double_Click
| dont voici l'image: 
Notez que - le RECORD n'a pas besoin d'être pointé. Si vous devez passer le RECORD à une PROCEDURE vous pouvez utiliser un paramètres VAR ou CONST, si vous
souhaitez éviter la copie des 3 pointeurs sur la pile (3 dans notre cas, mais si vous utilisez plus de données pour chaque tuple, cela peut devenir plus volumineux).
- comme précédemment nous n'avons pu accéder aux champs par la propriété
indexée Measure[], et WITH fonctionne en lecture, mais pas en écriture (il semble que nous modifions un RECORD local sur la pile, pas le RECORD de la tList)
La seconde solution consiste simplement à utiliser le RECORD de liste pointées:
type t_measure= Record
m_intensity_list, m_voltage_list,
m_frequency: t_tlist_of_pt_double;
end; // t_measure
|
ce qui est très similaire à la technique de RECORD of t_array_of_double
4.4 - tList OF c_doubles Finalement nous pouvons stocker les valeurs d'une même mesure dans une CLASSe, avec les deux structures suivantes:
Voici un exemple de CLASS OF CLASS, où nous avons placé dans chaque cellule des données contenant des doubles et n'importe quelle autre type de données
(ici 2 Doubles et un Integer): - voici les définitions pour notre gestion de séries boursières:
type c_stock_value=
Class
m_opening_price, m_closing_price: Double;
m_volume: Integer;
Constructor create(p_opening_price, p_closing_price: Double;
p_volume: Integer);
end; // c_doubles
c_tlist_of_c_doubles=
Class(tList)
Private
function get_stock_value(p_index: Integer): c_stock_value;
procedure set_stock_value(p_index: Integer;
p_c_stock_value: c_stock_value);
function get_opening_price(p_index: Integer): Double;
procedure set_opening_price(p_index: Integer;
p_opening_price: Double);
Public
Constructor create;
procedure add_stock_value(p_c_stock_value: c_stock_value);
Destructor Destroy; Override;
Property StockValue[p_index: Integer] : c_stock_value
Read get_stock_value Write set_stock_value; Default;
Property OpeningPrice[p_index: Integer] : Double
Read get_opening_price Write set_opening_price;
end; // c_tlist_of_c_doubles
| - qui sont implémentées ainsi:
// -- c_stock_value
Constructor c_stock_value.create(p_opening_price, p_closing_price: Double;
p_volume: Integer);
begin
Inherited Create;
m_opening_price:= p_opening_price;
m_closing_price:= p_closing_price;
m_volume:= p_volume;
end; // create
// -- c_tlist_of_c_doubles.
Constructor c_tlist_of_c_doubles.create;
begin
Inherited Create;
end; // create
procedure c_tlist_of_c_doubles.add_stock_value(p_c_stock_value: c_stock_value);
begin
Inherited Add(p_c_stock_value);
end; // add_stock_value
function c_tlist_of_c_doubles.get_stock_value(p_index: Integer): c_stock_value;
begin
if p_index>= Count
then Raise Exception.Create('p_index> m_count');
Result:= c_stock_value(Items[p_index]);
end; // get_stock_value
procedure c_tlist_of_c_doubles.set_stock_value(p_index: Integer; p_c_stock_value: c_stock_value);
var l_index: Integer;
begin
// -- if index beyond Count, create with 0 filled cells
if p_index>= Count
then
For l_index:= Count to p_index do
add_stock_value(c_stock_value.create(0.0, 0.0, 0));
// -- copy the values
with c_stock_value(Items[p_index]) do
begin
m_opening_price:= p_c_stock_value.m_opening_price;
m_closing_price:= p_c_stock_value.m_closing_price;
m_volume:= p_c_stock_value.m_volume;
end; // with c_stock_value()
end; // set_stock_value
function c_tlist_of_c_doubles.get_opening_price(p_index: Integer): Double;
begin
if p_index>= Count
then Raise Exception.Create('p_index> m_count');
Result:= c_stock_value(Items[p_index]).m_opening_price;
end; // get_opening_price
procedure c_tlist_of_c_doubles.set_opening_price(p_index: Integer; p_opening_price: Double);
var l_index: Integer;
begin
// -- if index beyond Count, create with 0 filled cells
if p_index>= Count
then
For l_index:= Count to p_index do
add_stock_value(c_stock_value.create(0.0, 0.0, 0));
// -- copy the values
with c_stock_value(Items[p_index]) do
m_opening_price:= p_opening_price;
end; // set_opening_price
Destructor c_tlist_of_c_doubles.destroy;
var l_index: Integer;
begin
for l_index:= 0 To Count- 1 do
c_stock_value(Items[l_index]).Free;
Inherited;
end; // destroy
| - et voici un projet Delphi de test:
var g_c_tlist_of_c_doubles: c_tlist_of_c_doubles= Nil;
procedure TForm1.create_listClick(Sender: TObject);
begin
g_c_tlist_of_c_doubles:= c_tlist_of_c_doubles.Create;
end; // create_arrayClick
procedure TForm1.add_doublesClick(Sender: TObject);
begin
if g_c_tlist_of_c_doubles= Nil
then g_c_tlist_of_c_doubles.Create;
g_c_tlist_of_c_doubles.add_stock_value(
c_stock_value.create(1.1, 1.3, 200));
g_c_tlist_of_c_doubles.add_stock_value(
c_stock_value.create(5.6, 5.4, 400));
// -- WITH tries to read beyond the end
// with g_c_tlist_of_c_doubles.StockValue[2] do
// m_opening_price:= 10.11
g_c_tlist_of_c_doubles.StockValue[2]:= c_stock_value.create(7.2, 7.8, 300);
// -- once the cell exists, can modify it
with g_c_tlist_of_c_doubles.StockValue[2] do
m_closing_price:= 77.8;
g_c_tlist_of_c_doubles.OpeningPrice[2]:= 99.9;
end; // add_doubles_Click
procedure TForm1.display_doublesClick(Sender: TObject);
var l_index: Integer;
begin
for l_index:= 0 to g_c_tlist_of_c_doubles.Count- 1 do
with g_c_tlist_of_c_doubles.StockValue[l_index] do
display(Format('open=%5.2f close=%5.2f vol=%5d',
[m_opening_price, m_closing_price, m_volume]));
end; // display_doubles_Click
procedure TForm1.free_listClick(Sender: TObject);
begin
FreeAndNil(g_c_tlist_of_c_doubles);
end; // free_double_Click
| dont voici l'image: 
La solution utilisant plusieurs tList de c_tList OF c_double serait définit par:
type t_stock_values= Record
m_c_opening_price_list,
m_c_closing_price_list: c_tList_of_c_double;
m_c_volume_list: c_tList_of_c_integer;
end; // t_stock_values
|
Notez que: - si nous avions des traitements distincts sur les listes de réels (pour les intensités, calculer la moyenne, pour les puissances la somme des carrés
etc), il la solution de droite serait la plus appropriée, alors que si tous les réels ont le même traitement, et que nous avons des traitements sur une mesure, la solution de gauche serait mieux adaptée
5 - Télécharger le code source Delphi Vous pouvez télécharger les différents projets: Ce .ZIP qui comprend:
- le .DPR, la forme principale, les formes annexes eventuelles
- les fichiers de paramètres (le schéma et le batch de création)
- dans chaque .ZIP, toutes les librairies nécessaires à chaque projet (chaque .ZIP est autonaume)
Ces .ZIP, pour les projets en Delphi 6, contiennent des chemins RELATIFS. Par conséquent: - créez un répertoire n'importe où sur votre machine
- placez le .ZIP dans ce répertoire
- dézippez et les sous-répertoires nécessaires seront créés
- compilez et exécutez
Ces .ZIP ne modifient pas votre PC (pas de changement de la Base de Registre, de DLL ou autre). Pour supprimer le projet, effacez le répertoire.
La notation utilisée est la notation alsacienne qui consiste à préfixer les identificateurs par la zone de compilation: K_onstant, T_ype, G_lobal,
L_ocal, P_arametre, F_unction, C_lasse. Elle est présentée plus en détail dans l'article La
Notation Alsacienne
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.
6 - Références
Nous avons déjà présenté des techniques similaires. En particulier
Ces techniques sont naturellement abordées dans nos formations sur les techniques de programmation objet, et en particulier
7 - 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.
|
