Discussion :

[aharel]

Bonjour,

Quelle est la meilleure solution pour cloner une TStringList contenant des objets ? Je précise que je souhaite que les objets de la propriété Objects doivent eux aussi être clonés. Ci-dessous un bout de code qui fonctionne, mais qui ne me semble pas terrible.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
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
 
unit Unit4;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
 
type
  TParam = class ( TPersistent )
  private
    FID : Integer;
  public
    constructor Create(pID : Integer);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  end;
 
  TParams = class ( TObject )
  public
    FList : TStringList;
    constructor Create(); overload;
    destructor Destroy; override;
    procedure Assign( Source: TParams );
    procedure AddParam( pLib : String; pParam: TParam);
    function Duplicate(): TParams;
  end;
 
  TForm4 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  Form4: TForm4;
 
implementation
 
{$R *.dfm}
 
{ TParams }
 
procedure TParams.AddParam(pLib: String; pParam: TParam);
begin
  self.FList.AddObject(pLib, pParam);
end;
 
procedure TParams.Assign(Source: TParams);
var
  iCptObj: Integer;
  lParam : TParam;
begin
  if ( Source is TParams ) then
  begin
    FList.Assign( Source.FList );
    for iCptObj := 0 to FList.Count-1 do
    begin
      FList.Objects[iCptObj] := TParam.Create(-1);
      lParam := TParam(FList.Objects[iCptObj]);
      lParam.Assign( Tparam(Source.FList.Objects[iCptObj]));
    end;
  end;
end;
 
constructor TParams.Create;
begin
  FList := TStringList.Create(true);
end;
 
destructor TParams.Destroy;
begin
  FList.Clear;
  FreeAndNil( FList );
  inherited;
end;
 
function TParams.Duplicate: TParams;
begin
  Result := TParams.Create();
    Result.Assign( self );
end;
 
{ TParam }
 
 
procedure TParam.Assign(Source: TPersistent);
begin
  //inherited;
  FID := TParam(Source).FID;
end;
 
constructor TParam.Create(pID: Integer);
begin
  FID := pID;
end;
 
procedure TForm4.Button1Click(Sender: TObject);
var
  Params1 : TParams;
  Params2 : TParams;
  lParam : TParam;
  icptParam: Integer;
  lMsg : String;
begin
  Params1 := TParams.Create;
  lParam := TParam.Create(1);
  Params1.AddParam('UN', lParam);
  lParam := TParam.Create(2);
  Params1.AddParam('DEUX', lParam);
 
  Params2 := Params1.Duplicate;
  for icptParam := 0 to Params2.FList.Count-1 do
  begin
    lMsg := Params2.FList[icptParam] + ' '+IntToStr(TParam(Params2.FList.Objects[icptParam]).FID);
    ShowMessage('Params2['+ IntToStr(icptParam)+ '] : ' + lMsg);
  end;
  Params1.Free;
  Params2.Free;
end;
 
destructor TParam.Destroy;
begin
  ShowMessage('Destruction TPAram');
  inherited;
end;
 
end.

[sgmsg]

À la volée :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Function CloneStringlist(Original:tStringlist; var Copie:tStringlist):Boolean;
var i:integer;
begin
    Result:=False; 
    if Original = Nil then exit;//l'original est vide alors on quitte, result peut être vrai o faux, j'ai pour habitude de mettre faux si aucun traitement n'est effectué
    if Copie <> Nil then begin //vide les objets dans la copie si ils peuvent l'être et libère ainsi les ressources qui pourraient se perdre dans le vide sidéral et intergalactique
        for i:=0 to Copie.Count-1 do 
              if Copie.Objects[i] <> nil 
                    then Copie.Objects[i].Free;
        Copie.free;//libère finalement les items
    end;
    try 
        Copie:=tStringlist.Create;
 
        Copie.Sorted:=Original.Sorted; 
        Copie.duplicate:=Original.Duplicate;
        //... ainsi que toutes les autres propriétés qu'on désire copier
 
        for i:=0 to Original.count-1 do 
             Copie.AddObject(Original[i],Original.Objects[i]);
        Result:=True;
    except
    end;
end;

[retwas]

Tu peux aussi deriver la méthode Assign ou te créer un type et utiliser une TObjectList<T>.

[e-ric]

À la volée :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Function CloneStringlist(Original:tStringlist; var Copie:tStringlist):Boolean;
var i:integer;
begin
    Result:=False; 
    if Original = Nil then exit;//l'original est vide alors on quitte, result peut être vrai o faux, j'ai pour habitude de mettre faux si aucun traitement n'est effectué
    if Copie <> Nil then begin //vide les objets dans la copie si ils peuvent l'être et libère ainsi les ressources qui pourraient se perdre dans le vide sidéral et intergalactique
        for i:=0 to Copie.Count-1 do 
              if Copie.Objects[i] <> nil 
                    then Copie.Objects[i].Free;
        Copie.free;//libère finalement les items
    end;
    try 
        Copie:=tStringlist.Create;
 
        Copie.Sorted:=Original.Sorted; 
        Copie.duplicate:=Original.Duplicate;
        //... ainsi que toutes les autres propriétés qu'on désire copier
 
        for i:=0 to Original.count-1 do 
             Copie.AddObject(Original[i],Original.Objects[i]);
        Result:=True;
    except
    end;
end;

Non, ici le clonage des objets associés n'a pas lieu, seules leurs références sont recopiées, on a donc un phénomène d'alias. Le problème du clonage dans Delphi (et dans bien d'autres langages) n'est pas simple surtout si les objets associés sont eux-mêmes composés car Delphi ne connaît qu'une logique de référence (l'affectation ne copie pas l'objet mais sa référence). Si tu as la main sur les classes de tes objets associés, une idée pourrait être de créer un constructeur Clone prenant en paramètre un objet de même classe et prenant toutes les dispositions nécessaires. Ne connaissant pas l'étendue de ton problème, difficile d'en dire plus.

Cdlt

[ShaiLeTroll]

Attention, comme le fait remarque e-ric avec le code de sgmsg, cela clone la liste mais les objets reste partagés par les deux listes

Bonjour,
Quelle est la meilleure solution pour cloner une TStringList contenant des objets? Je précise que je souhaite que les objets de la propriété Objects doivent eux aussi être clonés. Ci-dessous un bout de code qui fonctionne, mais qui ne me semble pas terrible.

Pourtant ton code n'est pas si mal, bonne gestion du Assign et de la propagation entre Liste TParams et Element TParam

Mais tu pourrais utiliser System.Classes.TCollection et System.Classes.TCollectionItem

La documentation de System.Classes.TCollection.Assign

Copie le contenu de la collection Source dans l'objet en cours.

Utilisez Assign pour copier le contenu d'une instance de TCollection dans une autre. La méthode Assign supprime tous les éléments de la collection de destination (l'objet où il est exécuté), puis ajoute une copie de chaque élément dans le tableau d'éléments (Items) de la collection source.

Source est un autre objet (typiquement une autre collection) contenant les éléments qui remplacent les éléments de cette collection.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
function TCollection.Add: TCollectionItem;
begin
  Result := FItemClass.Create(Self);
  Added(Result);
end;
 
procedure TCollection.Assign(Source: TPersistent);
var
  I: Integer;
begin
  if Source is TCollection then
  begin
    BeginUpdate;
    try
      // Replaces call to Clear to avoid BeginUpdate/try/finally/EndUpdate block
      while FItems.Count > 0 do
        TCollectionItem(FItems.List[FItems.Count - 1]).Free;
 
      for I := 0 to TCollection(Source).FItems.Count - 1 do
        Add.Assign(TCollection(Source).FItems[I]);
    finally
      EndUpdate;
    end;
    Exit;
  end;
  inherited Assign(Source);
end;

je vais étendre mon Helper existant pour écrire si tu veux rester en TStringList et pas en TCollection
Cela utilise le même principe, constructeur simple sans paramètre et Assign

Code :

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

ComboBox1.Items.CloneStringsAndPersistentObjects(ComboBox2.Items);

Code :

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

1
2
3
4
5
6
  TStringsSliteHelper = class helper for TStrings
  public
    procedure FreeAndNilObjects();
    procedure ClearStringsAndObjects();
    procedure CloneStringsAndPersistentObjects(ADestinationList: TStrings); 
  end;

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
{ TStringsSliteHelper }
 
//------------------------------------------------------------------------------
procedure TStringsSliteHelper.ClearStringsAndObjects();
begin
  TStringsSLTToolHelp.ClearStringsAndObjects(Self);
end;
 
//------------------------------------------------------------------------------
procedure TStringsSliteHelper.CloneStringsAndPersistentObjects(ADestinationList: TStrings);
begin
  TStringsSLTToolHelp.CloneStringsAndObjects(Self, ADestinationList);
end;
 
//------------------------------------------------------------------------------
procedure TStringsSliteHelper.FreeAndNilObjects();
begin
  TStringsSLTToolHelp.FreeAndNilObjects(Self);
end;

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
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
 
//------------------------------------------------------------------------------
(*                SoLuTions is an Versatile Library for Delphi                 -
 *                                                                             -
 *  Copyright ou © ou Copr. "SLT Solutions", (2006)                            -
 *  contributeur : ShaiLeTroll (2012) - Renommage Fichier et Correction XE2    -
 *  contributeur : ShaiLeTroll (2012) - Documentation Insight                  -
 *                                                                             -
 *                                                                             -
 * 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.Common.ClassesEx;
 
interface
 
uses
  System.Classes;
 
type
  /// <summary>Boite à outil pour la classe TStrings</summary>
  /// <remarks>Le TStringsSLTToolHelp n'est pas un class helper car lors de sa création en 2002 sous Delphi 5, le code était procédural,
  /// lors de la refonte en classe en 2007, la version utilisée était Delphi 7, en s'inspirant du concept des Assistances de classes (Class Helper) du Delphi.NET
  /// <para>En XE2, la TStringList offre une propriété OwnsObjects (n'existe pas dans la TStrings) qui se comportent comme celle d'une TObjectList, cela remplace ClearStringsAndObjects</para></remarks>
  TStringsSLTToolHelp = class(TObject)
  public
    class procedure FreeAndNilObjects(AList: TStrings); static;
    class procedure ClearStringsAndObjects(AList: TStrings); static;
    class procedure CloneStringsAndPersistentObjects(ASourceList: TStrings; ADestinationList: TStrings);
  end;
 
implementation
 
{ TStringsSLTToolHelp }
 
//------------------------------------------------------------------------------
class procedure TStringsSLTToolHelp.ClearStringsAndObjects(AList: TStrings);
begin
  if Assigned(AList) then
  begin
    FreeAndNilObjects(AList);
    AList.Clear();
  end;
end;
 
//------------------------------------------------------------------------------
class procedure TStringsSLTToolHelp.CloneStringsAndPersistentObjects(ASourceList: TStrings; ADestinationList: TStrings);
var
  I: Integer;
  S: string;
  Obj, ObjD: TObject;
begin
  if Assigned(ASourceList) and Assigned(ADestinationList) then
  begin
    ADestinationList.BeginUpdate();
    try
      ClearStringsAndObjects(ADestinationList);
 
      for I := 0 to ASourceList.Count - 1 do
      begin
        S := ASourceList.Strings[I];
        Obj := ASourceList.Objects[I];
        if Assigned(Obj) then
        begin
          ObjD := Obj.ClassType().Create(); // Attention pas de polymorphisme à ce niveau car le TObject n'a pas de constructeur virtuel
          (ObjD as TPersistent).Assign(TPersistent(Obj)); // Suppose une implementation de Assign qui assure le copie de l'objet, Exception sur l'opérateur "as" souhaité
          ADestinationList.AddObject(S, ObjD);
        end
        else
          ADestinationList.Add(S);
      end;
    finally
      ADestinationList.EndUpdate();
    end;
  end;
end;
 
//------------------------------------------------------------------------------
class procedure TStringsSLTToolHelp.FreeAndNilObjects(AList: TStrings);
var
  I: Integer;
  Obj: TObject;
begin
  if Assigned(AList) then
  begin
    for I := 0 to AList.Count - 1 do
    begin
      Obj := AList.Objects[I];
      if Assigned(Obj) then
      begin
        AList.Objects[I] := nil;
        Obj.Free();
      end;
    end;
  end;
end;
 
end.

[sgmsg]

Effectivement vous avez tout à fait raison... Et c'est écrit noir sur blanc...

Toutefois, c'est vraiment étrange de cloner des objets, tous mes programmes consistent plutôt à les partager au maximum.

Il doit y avoir des utilités, si je trouve je n'hésiterai pas à m'en servir.

A+