TList, record et tableau

Version imprimable

Bonjour,

Sous Berlin ...
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 TElement = record Position: Integer; Similars: TIntegerDynArray; end; PElement = ^TElement; TElements = TList<TElement>; ... Elements: TElements; for I := 0 to Elements.Count - 1 do SetLength(Elements[I].Similars, 2);
Delphi râle en me disant qu'il veut une variable pour le SetLength.
Si je tente une simple affectation, il dit que la partie gauche n'est pas affectable.
Bref, il me saoule.

Si je fais un TList de PElement, il est content mais pour le debug c'est moins pratique.

Et je n'arrive pas à trouver la bonne écriture pour avoir un pointer sur le record qui correspond à l'élément.

Je sais, je suis à la rue, merci de le faire remarquer :D

mais à part ça, elle est où la bonne syntaxe ?

C'est normal, dans le TList<TElement> quand tu affectes ton record, cela le recopie

En fait, quand tu récupère aussi la valeur, c'est aussi une copie!
Même si cela compilait, tu modifierais une copie !

En passant par un pointeur, cela copie le pointeur mais pas le record pointé ce qui te permet de le modifier
Tu peux aussi utiliser un objet, puis qu'un objet fonctionne par référence, et en plus avec une TObjectList<> tu auras la libération automatique via OwnObjects
Alors qu'avec le pointeur, il te faut utiliser New et Dispose !
Car attention
Ceci ne fonctionne pas

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
procedure TForm1.button1Click(Sender: TObject);
var
  Elements: TElements;
  E: TElement;
  I: Integer;
  S: string;
begin
  Elements := TElements.Create();
  try
    E.Position := 1;
    Elements.Add(@E);
    E.Position := 2; // oups tu as modifié l'élément index 0 car tu as pointé la mémoire dessus
    Elements.Add(@E); // doublon !
  finally
    Elements.Free();
  end;
end;

le bon code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
procedure TForm1.button1Click(Sender: TObject);
var
  Elements: TElements;
  E: PElement;
  I: Integer;
  S: string;
begin
  Elements := TElements.Create();
  try
    New(E);
    E^.Position := 1;
    Elements.Add(E);
 
    New(E);
    E^.Position := 2; 
    Elements.Add(E); 
 
    for I := 0 to Elements.Count - 1 do
      Dispose(Elements[I]); 
  finally
    Elements.Free();
  end;
end;

je te laisse apprécier ceci en record

Code:

1
2
3
4
5
6
7
 
Avant :
0 = 1 / 4
1 = 2 / 5
Après :
0 = 1 / 4
1 = 2 / 5

en pointeur de record

Code:

1
2
3
4
5
6
Avant :
0 = 1 / 4
1 = 2 / 5
Après :
0 = 10 / 9
1 = 20 / 12

et en class

Code:

1
2
3
4
5
6
Avant :
0 = 1 / 4
1 = 2 / 5
Après :
0 = 10 / 12
1 = 20 / 16

et le code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
 
{$DEFINE ELE_REC} // Actif en mode record, mets en commentaire cette ligne tu passe en mode class
// {$DEFINE ELE_P_REC} // Actif en mode pointer de record
 
{$IFDEF ELE_REC}
{$IFNDEF ELE_P_REC}
type
  TElement = record
    Position: Integer;
    Similars: TIntegerDynArray;
  public
    class function Create(APosition: Integer; ASimilarLength: Integer = 0): TElement; static;
    procedure SetPosition(APosition: Integer);
    procedure SetSimilarsLength(L: Integer);
  end;
 
  TElements = TList<TElement>;
 
class function TElement.Create(APosition: Integer; ASimilarLength: Integer = 0): TElement;
begin
  Result.Position := APosition;
  SetLength(Result.Similars, ASimilarLength);
end;
 
procedure TElement.SetPosition(APosition: Integer);
begin
  Self.Position := APosition;
end;
 
procedure TElement.SetSimilarsLength(L: Integer);
begin
  SetLength(Self.Similars, L * 2);
end;
{$ELSE IF ELE_P_REC}
type
  PElement = ^TElement;
  TElement = record
    Position: Integer;
    Similars: TIntegerDynArray;
  public
    class function CreateP(APosition: Integer; ASimilarLength: Integer = 0): PElement; static;
    procedure SetPosition(APosition: Integer);
    procedure SetSimilarsLength(L: Integer);
  end;
 
  TElements = class(TList<PElement>)
  protected
    procedure Notify(const Value: PElement; Action: TCollectionNotification); override;
  end;
 
class function TElement.CreateP(APosition: Integer; ASimilarLength: Integer = 0): PElement;
begin
  New(Result);
  Result.Position := APosition;
  SetLength(Result.Similars, ASimilarLength);
end;
 
procedure TElement.SetPosition(APosition: Integer);
begin
  Self.Position := APosition;
end;
 
procedure TElement.SetSimilarsLength(L: Integer);
begin
  SetLength(Self.Similars, L * 3);
end;
 
procedure TElements.Notify(const Value: PElement; Action: TCollectionNotification);
begin
  inherited;
  if Action = cnRemoved then
    Dispose(Value);
end;
{$ENDIF ELE_P_REC}
{$ELSE ELE_REC}
type
  TElement = class(TObject)
    Position: Integer;
    Similars: TIntegerDynArray;
  public
    class function CreateFrom(APosition: Integer; ASimilarLength: Integer = 0): TElement;
    constructor Create(APosition: Integer; ASimilarLength: Integer = 0);
    procedure SetPosition(APosition: Integer);
    procedure SetSimilarsLength(L: Integer);
  end;
 
  TElements = TObjectList<TElement>;
 
class function TElement.CreateFrom(APosition: Integer; ASimilarLength: Integer = 0): TElement;
begin
  Result := TElement.Create(APosition, ASimilarLength);
end;
 
constructor TElement.Create(APosition: Integer; ASimilarLength: Integer = 0);
begin
  Self.Position := APosition;
  SetLength(Self.Similars, ASimilarLength);
end;
 
procedure TElement.SetPosition(APosition: Integer);
begin
  Self.Position := APosition;
end;
 
procedure TElement.SetSimilarsLength(L: Integer);
begin
  SetLength(Self.Similars, L * 4);
end;
{$ENDIF ELE_REC}
 
 
procedure TForm1.button1Click(Sender: TObject);
var
  Elements: TElements;
  I: Integer;
  S: string;
begin
{$IFDEF ELE_REC}
{$IFNDEF ELE_P_REC}
  Elements := TElements.Create();
  try
    Elements.Add(TElement.Create(1, 4));
    Elements.Add(TElement.Create(2, 5));
{$ELSE ELE_P_REC}
  Elements := TElements.Create();
  try
    Elements.Add(TElement.CreateP(1, 4));
    Elements.Add(TElement.CreateP(2, 5));
{$ENDIF ELE_P_REC}
{$ELSE ELE_REC}
  Elements := TElements.Create(True);
  try
    Elements.Add(TElement.CreateFrom(1, 4));
    Elements.Add(TElement.CreateFrom(2, 5));
{$ENDIF ELE_REC}
 
    S := 'Avant :';
    for I := 0 to Elements.Count - 1 do
      S := S + sLineBreak + Format('%d = %d / %d', [I, Elements[I].Position, Length(Elements[I].Similars)]);
 
    for I := 0 to Elements.Count - 1 do
    begin
      Elements[I].SetPosition(Elements[I].Position * 10);
      Elements[I].SetSimilarsLength(Length(Elements[I].Similars) - 1);
    end;
 
    S :=  S + sLineBreak + 'Après :';
    for I := 0 to Elements.Count - 1 do
      S := S + sLineBreak + Format('%d = %d / %d', [I, Elements[I].Position, Length(Elements[I].Similars)]);
 
    ShowMessage(S);
 
  finally
    Elements.Free();
  end;
end;

15/02/2017, 22h34
Invité

J'ai pris l'habitude d'utiliser les TObjectList et comme indiqué dans le post précédent il s'agit d'une solution possible :)

Citation:

Envoyé par ShaiLeTroll

Ceci ne fonctionne pas

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
procedure TForm1.button1Click(Sender: TObject);
var
  Elements: TElements;
  E: TElement;
  I: Integer;
  S: string;
begin
  Elements := TElements.Create();
  try
    E.Position := 1;
    Elements.Add(@E);
    E.Position := 2; // oups tu as modifié l'élément index 0 car tu as pointé la mémoire dessus
    Elements.Add(@E); // doublon !
  finally
    Elements.Free();
  end;
end;

Ca peut meme etre pire :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
function TForm1.CreateElements(Sender: TObject): TElements;
var
  E: TElement;
begin
  Result := TElements.Create();
  try
    E.Position := 1;
    Result.Add(@E);
    E.Position := 2; // oups tu as modifié l'élément index 0 car tu as pointé la mémoire dessus
    Result.Add(@E); // doublon !
  except
    Result.Free();
    raise;
  end;
end; //re-oups, la variable E locale pointée par result n'existe plus ici

16/02/2017, 09h45
Papy214

Merci Shaï (et les autres aussi bien sur :) )

Ca confirme donc ce que j'avais expérimenté et qui va m'obliger à changer la méthode.
Heureusement, je n'en suis qu'au début du projet et ça n'aura pas trop d'incidence.

Je voulais économiser un peu de temps sur l'écriture en évitant de gérer les créations/destruction d'objet mais j'aurais du m'abstenir.

En revanche, j'ai une question complémentaire en rapport avec le sujet.

Hormis la gestion supplémentaire des éléments, je pensais qu'un record était moins gourmand en ressources qu'un objet.
Et donc, qu'un TList de 15000 record par exemple est plus intéressant que l'équivalent mémoire de la même liste d'objets.
C'est une fausse idée ou non ??

Oui, c'est plus léger
Compare avec un SizeOf et un InstanceSize
Mais avoir autant d'objet c'est louche !
Et comme tu peux le voir avec le Pointeur PElement tu peux encaspuler l'allocation New et libération Dispose ...
Je l'ai beaucoup pratiqué et encore aujourd'hui avec la TThreadList

en plus l'objet permet du polymorphisme, cela peut-être utile
même si avec une partie variable d'un enregistrement on peut aussi le simuler

Quand j'ai beaucoup de donnée, c'est souvent issu de la Base de Données ou d'un fichier
Je me suis fait une couche objet métier qui se comporte comme un DataSet, tout est stocké dans un tableau de pointeur, j'ai les opérateurs First, Next ...
Cette couche objet métier peut fonctionne en mode autonome (avec le tableau de pointeur) ou en mode DB (avec un DataSet sous-jacents qui se substitue au tableau) ensuite tout est géré par RTTI et GUID-Interface, ...

Voici juste le tout début des 4000 lignes de code de cette unité, mon ORM en fait en total 10000

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
 
//------------------------------------------------------------------------------
(*                SoLuTions is an Versatile Library for Delphi                 -
 *                                                                             -
 *  Copyright ou © ou Copr. "SLT Solutions", (2006)                            -
 *  contributeur : ShaiLeTroll (2009) - Refonte architecturale (Séparation de l'ORM : l'EPC "Engine of Persistence Component" gère uniquement une ORM très rigide, la nouvelle persistance sépare la partie RTTI de la gestion DB)
 *  contributeur : ShaiLeTroll (2012) - Renommage Fichier et Correction XE2    -
 *  contributeur : ShaiLeTroll (2012) - Documentation Insight                  -
 *  contributeur : ShaiLeTroll (2013) - Fusion de la SLT<2006> sous Delphi 7, SLT<2009> sous C++Builder 2007, SLT<2012> sous C++Builder XE2/XE3 vers la SLT<2013> sous Delphi XE2
 *                                                                             -
 *                                                                             -
 * Ce logiciel est un programme informatique servant à aider les développeurs  -
 * Delphi avec une bibliothèque polyvalente, adaptable et fragmentable.        -
 *                                                                             -
 * Ce logiciel est régi par la licence CeCILL-C soumise au droit français et   -
 * respectant les principes de diffusion des logiciels libres. Vous pouvez     -
 * utiliser, modifier et/ou redistribuer ce programme sous les conditions      -
 * de la licence CeCILL-C telle que diffusée par le CEA, le CNRS et l'INRIA    -
 * sur le site "http://www.cecill.info".                                       -
 *                                                                             -
 * En contrepartie de l'accessibilité au code source et des droits de copie,   -
 * de modification et de redistribution accordés par cette licence, il n'est   -
 * offert aux utilisateurs qu'une garantie limitée.  Pour les mêmes raisons,   -
 * seule une responsabilité restreinte pèse sur l'auteur du programme,  le     -
 * titulaire des droits patrimoniaux et les concédants successifs.             -
 *                                                                             -
 * A cet égard  l'attention de l'utilisateur est attirée sur les risques       -
 * associés au chargement,  à l'utilisation,  à la modification et/ou au       -
 * développement et à la reproduction du logiciel par l'utilisateur étant      -
 * donné sa spécificité de logiciel libre, qui peut le rendre complexe à       -
 * manipuler et qui le réserve donc à des développeurs et des professionnels   -
 * avertis possédant  des  connaissances  informatiques approfondies.  Les     -
 * utilisateurs sont donc invités à charger  et  tester  l'adéquation  du      -
 * logiciel à leurs besoins dans des conditions permettant d'assurer la        -
 * sécurité de leurs systèmes et ou de leurs données et, plus généralement,    -
 * à l'utiliser et l'exploiter dans les mêmes conditions de sécurité.          -
 *                                                                             -
 * Le fait que vous puissiez accéder à cet en-tête signifie que vous avez      -
 * pris connaissance de la licence CeCILL-C, et que vous en avez accepté les   -
 * termes.                                                                     -
 *                                                                             -
 *----------------------------------------------------------------------------*)
unit SLT.Persistence.Impl;
 
interface
 
uses System.Classes, System.SysUtils, System.TypInfo,
  System.Generics.Collections,
  SLT.Common.SystemEx, SLT.Common.ThreadUtils, SLT.Common.RTTI,
  SLT.Persistence.Interfaces;
 
{$SCOPEDENUMS ON}
 
type
  { Forward class declarations }
  TSLTPersistent = class;
  TSLTPersistentSet = class;
  TSLTPersistentEvent = class;
  TSLTPersistentRTTIAccess = class;
  TSLTPersistentFactories = class;
  TSLTPersistentSetFactories  = class;
  TSLTPersistentFactoryRegistry = class;
  ISLTPersistentFactoriesWithRegistry = interface;
  TSLTPersistentPropertyMetaData = class;
  TSLTPersistentPropertiesMetaData = class;
  TSLTPersistentPropertyData = class;
  TSLTPersistentPropertyValue = class;
  TSLTPersistentAbstractPropertiesData = class;
  TSLTPersistentPropertiesData = class;
  TSLTPersistentSetPropertiesData = class;
  TSLTPersistentPropertyByIndexAccessors = class;
  TSLTPersistentNullablePropertyValue = class;
  TSLTPersistentNullableInteger = class;
  TSLTPersistentNullableString = class;
  TSLTPersistentNullableDouble = class;
  TSLTPersistentNullablePropertyKindRegistry = class;
  TSLTPersistentSpecialIntegerValue = class;
  TSLTPersistentSetActiveNumberValue = class;
  TSLTPersistentMarshalling = class;
  TSLTPersistentMarshaller = class;
  TSLTPersistentSetMarshaller = class;
 
  /// <summary>Erreur de base liée à l'utilisation d'un objet supportant une persistance</summary>
  ESLTPersistentError = class(Exception);
  /// <summary>Erreur de base liée à l'utilisation des meta-données d'un objet supportant une persistance</summary>
  ESLTPersistentMetaDataError = class(Exception);
 
  /// <summary>Erreur liée à la conversion de type variant lors de la modification des données objet supportant une persistance</summary>
  ESLTPersistentPropertyValueCastError = class(ESLTPersistentError)
  private
    FPublishedPropertiesDescriptor: TClass;
    FPropertyName: string;
  public
    /// <summary>Crée l'exception avec un message prédéfini</summary>
    constructor Create(const APublishedPropertiesDescriptor: TClass; const APropertyName: string; const ASourceType, ADestType: TVarType; const ADestKind: TTypeKind);
 
    property PublishedPropertiesDescriptor: TClass read FPublishedPropertiesDescriptor;
    property PropertyName: string read FPropertyName;
  end;
 
  { Default implementation class declarations }
 
  /// <summary>Objet de base pour les objets supportant une persistance</summary>
  /// <remarks>La classe TSLTPersistent doit être utilisée de préférence via l'interface ISLTPersistent.</remarks>
  /// <remarks>La classe TSLTPersistent peut-être héritée et ses méthodes d'implémentation redéfinies.</remarks>
  /// <remarks>La classe TSLTPersistent peut-être utilisée via une simple composition et dans ce cas : il est nécessaire d'affecter, à la propriété
  /// PublishedPropertiesDescriptor, la classe d'objet contenant des propriétés publiées accessibles en RTTI.
  /// L'approche par composition avec une encapsulation totale permet un couplage faible entre votre code métier et l'utilisation de cette implémentation de persistance,
  /// vous pourrez ainsi par la suite fournir vos implémentations personnalisées ou remplacer totalement cette bibliothèque par une autre bibliothèque répondant au mieux à vos besoins.</remarks>
  /// <remarks>En modifiant les accesseurs ou fabriques des classes gérant les Délégation,
  /// vous pouvez fournir votre implémentation personnalisée de ISLTPersistentFactories,
  /// ainsi que d'autres implémentations personnalisées des interfaces que vous jugerez nécessaire à votre objet.</remarks>
  /// <remarks>La classe TSLTPersistent n'est pas obligatoire, vous pouvez créer votre propre ancêtre persistant tant qu'il implémente correctement ISLTPersistentPropertiesMetaData et ISLTPersistentPropertiesData,
  /// votre propre ancêtre persistant peut fournir sa propre implémentation de ISLTPersistentFactories vous permettant de substituer l'ensemble des implémentations par défaut par des implémentations personnalisées</remarks>
  TSLTPersistent = class(TSLTInterfacedObject, ISLTPersistent, ISLTPersistentRTTIAccess, ISLTPersistentFactories, ISLTPersistentPropertiesMetaData, ISLTPersistentPropertiesData,
    ISLTPersistentNullablePropertyKindRegistry, ISLTPersistentPropertyByIndexAccessors, ISLTPersistentNullablePropertyByIndexAccessors, ISLTPersistentVariantPropertyByIndexAccessors, ISLTPersistentSpecialPropertyByIndexAccessors,
    ISLTPersistentMarshalling, ISLTPersistentMarshallable, ISLTPersistentSetCountable, ISLTPersistentLoadStateInspector)
  strict private
    // Membres privés de Classe
    class var
      FDefaultFactoriesClass: TClass;
 
  public
    // Types publiques
    type
      TDelegate = (dFactories, dPropertiesMetaData, dPropertiesData, dPbIAccess, dNPbIAccess, dVPbIAccess, dSPbIAccess, dNPKindRegistry);
      TDelegates = set of TDelegate;
      IDelegatedInterface = IInterface;
      PDelegatedInterface = ^IDelegatedInterface;
      TDelegatedInterfaces = array[TDelegate] of IDelegatedInterface;
      PDelegatedInterfaces = ^TDelegatedInterfaces;
      TStaticDelegatedInterfaces = class(System.Generics.Collections.TDictionary<TClass, PDelegatedInterfaces>)
      private
        function GetDelegate(const Key: TClass): PDelegatedInterfaces;
      protected

16/02/2017, 10h24
Papy214

Je vois qu'il y a un énorme boulot derrière tout ça mais le projet a traiter n'a pas le budget associé à ce genre de développement.

Aujourd'hui, il s'agit d'avoir une classe qui a diverses données plus une un TList d'éléments composés d'une position, d'un nom, d'un tableau dynamique de valeurs entières et un autre tableau d'entiers qui est rempli dans un second temps.
Pour remplir le TList avec les les records au démarrage, ça fonctionne. Le fichier est lu et les éléments ajoutés.
La variable locale du type record est rempli et ajouté au TList. Là, je n'ai pas de problème de duplication. Le .Add crée bien un nouvel élément à chaque fois.
Le second tableau est rempli par la suite en fonction de certaines comparaisons entre les éléments.
En gros, on trie le TList par rapport au tableau des éléments et ensuite on cherche ceux qui sont semblables.
Les semblables trouvés sont ajoutés au second tableau.

Et c'est là que ça a commencé à "bloquer".
En utilisant des PElement, je n'ai pas de problème sauf qu'en debug c'est moins pratique.
De plus, une personne prendra le relais du projet après moi et cette personne n'a pas les mêmes connaissances.
Il faut donc que je facilite le code au maximum. Passer par des pointer va lui compliquer la tâche.
Avec des objets ça sera plus simple pour la continuation.

Juste par curiosité, ton framework maison, tu as mis combien de temps pour l'écrire ?