Copier un objet dans un enfant

**ILP** · 13/04/2016, 12h34

Bonjour,
Je cherche un moyen d'automatiser la copie d'objet afin que lors de la création d'un objet enfant, je puisse utiliser un objet parent pour l'initialiser.
Je m'explique : j'ai un objet TParametreChamp de type TPersistent et son enfant TParametreChampEntier. Leurs prototypes se présentent comme ceci :

Code Delphi :

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
type
 
  TTypeParametre = (tpAlphabetique = 1, tpMemo = 2, tpTelephone = 3, tpCourriel = 4, tpDate = 5, tpBoolean = 6);
 
  TParametreChamp = class(TPersistent)
  private
    FID       : Int64;
    FLibelle  : string;
    FTypeChamp: TTypeParametre;
    FPosition : Int32;
    FLock     : Boolean;
  public
    constructor Create();
  published
    property ID: Int64
      read   FID
      write  FID;
    property Libelle: string
      read   FLibelle
      write  FLibelle;
    property TypeChamp: TTypeParametre
      read   FTypeChamp
      write  FTypeChamp;
    property Position: Int32
      read   FPosition
      write  FPosition;
    property Lock: Boolean
      read   FLock
      write  FLock;
  end;
 
  TParametreChampEntier = class(TParametreChamp)
  private
    FNomTable   : string;
    FNomChamp   : string;
    FNomTableID : string;
    FMaitreTable: string;
    FMaitreChamp: string;
  public
    constructor Create(); overload;
    constructor Create(const AParametreChamp: TParametreChamp); overload;
  published
    property NomTable: string
      read   FNomTable
      write  FNomTable;
    property NomChamp: string
      read   FNomChamp
      write  FNomChamp;
    property NomTableID: string
      read   FNomTableID
      write  FNomTableID;
    property MaitreTable: string
      read   FMaitreTable
      write  FMaitreTable;
    property MaitreChamp: string
      read   FMaitreChamp
      write  FMaitreChamp;
  end;

Lors de la création de chaque objets, j'initialise le contenu de leurs champs

Code Delphi :

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
{ TParametreChamp }
 
constructor TParametreChamp.Create();
begin
  inherited;
 
  FID        := 0;
  FLibelle   := '';
  FTypeChamp := tpAlphabetique;
  FPosition  := 0;
  FLock      := False;
end;
 
{ TParametreChampEntier }
 
constructor TParametreChampEntier.Create();
begin
  inherited;
 
  FNomTable    := '';
  FNomChamp    := '';
  FNomTableID  := '';
  FMaitreTable := '';
  FMaitreChamp := '';
end;
 
constructor TParametreChampEntier.Create(const AParametreChamp: TParametreChamp);
begin
  Create();
 
  AParametreChamp.AssignTo(TParametreChamp(Self));
end;

Mais lorsque je veux créer un objet TParametreChampEntier à partir d'un TParametreChamp, j'ai une erreur : "EConvertError : Impossible d'affecter TParametreChamp à TParametreChampEntier".

Quelqu'un aurait une idée de méthode, ou dois-je copier les valeurs de tous les champs un par un ?
Merci.

**ShaiLeTroll** · 13/04/2016, 13h43

il te faut faire un override du AssignTo pour écrire ton propre code où tu devras copier les valeurs de tous les champs un par un

Code :

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

1
2
    procedure Assign(Source: TPersistent); override;
    procedure AssignTo(Dest: TPersistent); override;

Je suppose que tu veux recopier les parties communes de l'objet ancêtre vers l'objet hérité

pour faciliter la lecture du code j'aurais plutôt modifier Assign !

Assign c'est quand l'objet connait ses sources, souvent limité à un clone de soi-même
AssignTo c'est quand l'objet receveur ne connait pas toutes ses sources et c'est donc à l'objet devant être copier de savoir comment se copier vers l'objet Dest
Lorsque TPersistent.Assign ne sais pas quoi faire d'un objet, il fini par appeler AssignTo, c'est pour cela qu'une fois avoir gérer les sources connues, il faut appeler inherited Assign qui finira par appeler AssignTo.
Dans ton cas, c'est un clone d'un ancêtre vers un hérité, donc Assign

Code :

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

1
2
3
4
5
6
7
 
constructor TParametreChampEntier.Create(const AParametreChamp: TParametreChamp);
begin
  Create();
 
  Assign(AParametreChamp);
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
procedure TParametreChamp.Assign(ASource: TPersistent);
begin
  if ASource is TParametreChamp then
  begin
    FLock := True;
    try
      FID := TParametreChamp(ASource).FID;
      FLibelle := TParametreChamp(ASource).FLibelle;
      FTypeChamp := TParametreChamp(ASource).FTypeChamp;
      FPosition := TParametreChamp(ASource).FPosition;
    finally
      FLock := False;
    end;
  end;
  else
    inherited Assign(ASource);
end;

Tu peux aussi utiliser des RTTI pour cloner un objet avec des propriétés publiées communes mais toujours dans l'idée d'un override du Assign ou du AssignTo
D'ailleurs, l'utilisation tu TPersistent n'a quasiment qu'un seul intérêt c'est les RTTI
J'ai beaucoup d'objet avec un Assign mais qui n'hérite que du TObject

Voici la version C++, j'ai le même en Delphi (plus lourde et plus spécifique à mes besoins de l'époque)

Code c++ :

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
 
//---------------------------------------------------------------------------
/*override*/void __fastcall TShaiORPersistent::Assign(TPersistent* Source)
{
  if ( ! IsRelation())
    this->PrimaryID = -1;
 
  if (Source && Source->InheritsFrom(__classid(TShaiORPersistent)))
  {
    this->DataSource = ((TShaiORPersistent*)Source)->DataSource;
    if ( ! this->DataSource)
      SetPublishedPropertiesFromPersistent(Source);
  }
  else if (Source && Source->InheritsFrom(__classid(TDataSet)))
  {
    this->DataSource = NULL;
    SetPublishedPropertiesFromDataSet((TDataSet*)Source);
  }
  else
    inherited::Assign(Source);
}
 
//---------------------------------------------------------------------------
/**
 * SetPublishedPropertiesFromPersistent fill object with another object
 * @return number of affected properties (-1 on null object)
 */
int TShaiORPersistent::SetPublishedPropertiesFromPersistent(TPersistent* APersistent)
{
  int Result = -1;
  if (APersistent)
  {
    Result = 0;
 
    TStringList *PropList = new TStringList();
    try
    {
      if (TShaiRTTIWrapper::GetPersistentProperties(APersistent->ClassType(), PropList))
      {
        for (int i = 0; i < PropList->Count; i++)
        {
          TPropertyName PropertyName = PropList->Strings[i];
 
          // Certaines propriétés publiées peuvent être en Lecture Seule, le chargement doit se faire manuellement !
          if (Typinfo::IsPublishedProp(this, PropertyName) && GetPropInfo(this, PropertyName)->SetProc)
          {
            Typinfo::SetPropValue(this, PropertyName, GetPropValue(APersistent, PropertyName, false));
            Result++;
          }
        }
      }
    }
    __finally
    {
      delete PropList;
    }
  }
 
  return Result;
}
 
//---------------------------------------------------------------------------
//                            TShaiRTTIWrapper                              -
//---------------------------------------------------------------------------
/*static*/ bool TShaiRTTIWrapper::GetPersistentProperties(TClass AClass, TStrings* AList, bool APersistentOnly/* = true*/)
{
  Typinfo::PPropInfo PropInfo;
 
  bool Result = AList && ( ! APersistentOnly || (APersistentOnly && AClass->InheritsFrom(__classid(TPersistent))));
  if (Result)
  {
    // Nettoyage de la Liste
    AList->Clear();
    // Récupération des Informations RTTI de la Classe
    PTypeInfo TypeInfo = (PTypeInfo)AClass->ClassInfo();
    // Obtention du Nombre de Propriété de la Classe
    int Count = Typinfo::GetTypeData(TypeInfo)->PropCount;
    Result = Count;
    if (Count)
    {
      // Allocation de la mémoire pour la Liste des Propriétés de la Classe
      Typinfo::PPropList PropList = (Typinfo::PPropList)malloc(Count * sizeof(Typinfo::PPropList));
      try
      {
        // Récupération du Tableur de Pointeur décrivant les Propriétés de la Classe
        Typinfo::GetPropInfos(TypeInfo, PropList);
        Typinfo::PPropInfo PropInfo;
        Typinfo::PPropInfo *PropItem = PropList->data;
        for (int i = 0; i < Count; i++)
        {
          // Récupération du Ieme Element décrivant l'une des Propriétés de la Classe
          PropInfo = *PropItem++;
 
          // Ajout du Nom de l'une des Propriétés de la Classe dans la Liste
          if (PropInfo)
            AList->Add(GetPropName(PropInfo));
        }
      }
      __finally
      {
        // Libération de la mémoire pour la Liste des Propriétés de la Classe
        free(PropList);
      }
    }
  }
 
  return Result;
}

**ILP** · 13/04/2016, 18h16

Super cool

Ta méthode à l'air de marcher. Sauf pour mon champ de type énuméré, mais c'est un détail.

Je mets le code en Pascal Object si jamais ça intéresse des personnes.

Code Delphi :

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
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
type
  TParametreChamp = class(TPersistent)
  private
    FID       : Int64;
    FLibelle  : string;
    FPosition : Int32;
    FLock     : Boolean;
  protected
    function SetPublishedPropertiesFromPersistent(var APersistent: TPersistent): Integer;
    procedure Assign(Source: TPersistent); override;
  public
    constructor Create();
  published
    property ID: Int64
      read   FID
      write  FID;
    property Libelle: string
      read   FLibelle
      write  FLibelle;
    property Position: Int32
      read   FPosition
      write  FPosition;
    property Lock: Boolean
      read   FLock
      write  FLock;
  end;
 
  TParametreChampEntier = class(TParametreChamp)
  private
    FNomTable   : string;
    FNomChamp   : string;
    FNomTableID : string;
    FMaitreTable: string;
    FMaitreChamp: string;
  public
    constructor Create(); overload;
    constructor Create(const AParametreChamp: TParametreChamp); overload;
  published
    property NomTable: string
      read   FNomTable
      write  FNomTable;
    property NomChamp: string
      read   FNomChamp
      write  FNomChamp;
    property NomTableID: string
      read   FNomTableID
      write  FNomTableID;
    property MaitreTable: string
      read   FMaitreTable
      write  FMaitreTable;
    property MaitreChamp: string
      read   FMaitreChamp
      write  FMaitreChamp;
  end;
 
{ TParametreChamp }
 
constructor TParametreChamp.Create();
begin
  inherited;
 
  FID        := 0;
  FLibelle   := '';
  FPosition  := 0;
  FLock      := False;
end;
 
function TParametreChamp.SetPublishedPropertiesFromPersistent(var APersistent: TPersistent): Integer;
var
  slPropList  : TStringList;
  TypeInfo    : PTypeInfo;
  PropList    : PPropList;
  PropInfo    : PPropInfo;
  PropertyName: string;
  Count       : Integer;
  i           : Integer;
begin
  Result := -1;
 
  if Assigned(APersistent) then
  begin
    Result     := 0;
    slPropList := TStringList.Create();
    try
      // Nettoyage de la liste
      slPropList.Clear();
 
      // Récupération des informations RTTI de la classe
      TypeInfo := APersistent.ClassInfo();
 
      // Obtention du nombre de propriété de la classe
      Count := TypeInfo.TypeData().PropCount;
 
      if Count > 0 then
      begin
        // Allocation de la mémoire pour la liste des propriétés de la classe
        PropList := AllocMem(SizeOf(PPropList));
 
        try
          // Récupération du tableau de pointeur décrivant les propriétés de la classe
          GetPropInfos(TypeInfo, PropList);
 
          for i := 0 to Count - 1 do
          begin
            // Récupération du ieme Element décrivant l'une des propriétés de la classe
            PropInfo := PropList[i];
 
            // Ajout du nom de l'une des propriétés de la classe dans la liste
            if Assigned(PropInfo) then
              slPropList.Add(GetPropName(PropInfo));
          end;
        finally
          FreeMem(PropList);
        end;
 
        for i := 0 to slPropList.Count - 1 do
        begin
          PropertyName := slPropList[i];
 
          // Certaines propriétés publiées peuvent être en lecture seule, le chargement doit se faire manuellement !
          if IsPublishedProp(Self, PropertyName) and Assigned(GetPropInfo(Self, PropertyName).SetProc) then
          begin
            SetPropValue(Self, PropertyName, GetPropValue(APersistent, PropertyName, False));
            Inc(Result);
          end;
        end;
      end;
    finally
      slPropList.Free();
    end;
  end;
end;
 
procedure TParametreChamp.Assign(Source: TPersistent);
begin
  if Assigned(Source) and Source.InheritsFrom(TParametreChamp) then
    SetPublishedPropertiesFromPersistent(Source)
  else
    inherited Assign(Source);
end;
 
{ TParametreChampEntier }
 
constructor TParametreChampEntier.Create();
begin
  inherited;
 
  FNomTable    := '';
  FNomChamp    := '';
  FNomTableID  := '';
  FMaitreTable := '';
  FMaitreChamp := '';
end;
 
constructor TParametreChampEntier.Create(const AParametreChamp: TParametreChamp);
begin
  Create();
 
  Self.Assign(AParametreChamp);
end;

Et donc, pour le Create(), il suffit de faire par exemple :

Code Delphi :

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

1
2
3
4
5
6
7
vParametreChamp           := TParametreChamp.Create();
vParametreChamp.ID        := 10;
vParametreChamp.Libelle   := 'Test';
vParametreChamp.Position  := 15;
vParametreChamp.Lock      := True;
 
vParametreChampEntier := TParametreChampEntier.Create(vParametreChamp);

Bonne journée

**ILP** · 13/04/2016, 18h47

Après un petit tour sur la documentation d'Embarcadero, j'ai constaté que les types énumérés qui ont des valeurs spécifiques, ne commençant pas à 0 et ne se suivant pas, n'ont pas de RTTI. C'est une limitation volontaire.

**ShaiLeTroll** · 14/04/2016, 09h32

Modifie ton enum en ajoutant une valeur 0, c'est ce que je fais tout le temps !
Cela permet d'ailleurs d'avoir une valeur par défaut neutre,

Code :

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

TTypeParametre = (tpNone, tpAlphabetique, tpMemo, tpTelephone, tpCourriel, tpDate, tpBoolean);

Après ton enum c'est proche de

Code :

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

TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord, ...

**Papy214** · 14/04/2016, 17h32

Je sais que j'arrive après la bagarre mais quelle version est utilisée dans ce cas précis ?

A partir d'une certaine version de delphi on peut utiliser du json qui facilite la tâche mais ça ne fonctionne que sur les propriétés published. Et ça fonctionne aussi sur les propriétés enum

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
 
unit Unit8;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, rest.json, system.json;
 
type
  TRtt = (trUn, trDeux, trTrois);
 
  TTest = class
  private
    Frtt: Trtt;
  published
    property Rtt: Trtt read Frtt write Frtt;
  end;
 
  TForm8 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  end;
 
var
  Form8: TForm8;
 
implementation
 
{$R *.dfm}
 
procedure TForm8.Button1Click(Sender: TObject);
var
  Test: TTest;
  S: string;
begin
  Test := TTest.Create;
  Test.Rtt := Trtt.trDeux;
  S := Rest.json.TJson.ObjectToJsonString(Test);
  Test.Free;
  ShowMessage(S);
 
  Test := Rest.json.TJson.JsonToObject<TTest>(S);
  ShowMessage(Ord(Test.Rtt).ToString);
 
  Test.Free;
end;
 
end.

Copier un objet dans un enfant

Langage Delphi

Vue hybride

Discussions similaires

Partager

Partager