IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Langage Delphi Discussion :

Copier un objet dans un enfant


Sujet :

Langage Delphi

  1. #1
    ILP
    ILP est déconnecté
    Membre confirmé
    Avatar de ILP
    Homme Profil pro
    Analyste programmeur
    Inscrit en
    Mai 2002
    Messages
    258
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 38
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : Analyste programmeur
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Mai 2002
    Messages : 258
    Points : 607
    Points
    607
    Par défaut Copier un objet dans un enfant
    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.

  2. #2
    Expert éminent sénior
    Avatar de ShaiLeTroll
    Homme Profil pro
    Développeur C++\Delphi
    Inscrit en
    Juillet 2006
    Messages
    13 429
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 42
    Localisation : France, Seine Saint Denis (Île de France)

    Informations professionnelles :
    Activité : Développeur C++\Delphi
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Juillet 2006
    Messages : 13 429
    Points : 24 794
    Points
    24 794
    Par défaut
    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;
    }
    Aide via F1 - FAQ - Guide du développeur Delphi devant un problème - Pensez-y !
    Attention Troll Méchant !
    "Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson" Confucius
    Mieux vaut se taire et paraître idiot, Que l'ouvrir et de le confirmer !
    L'ignorance n'excuse pas la médiocrité !

    L'expérience, c'est le nom que chacun donne à ses erreurs. (Oscar Wilde)
    Il faut avoir le courage de se tromper et d'apprendre de ses erreurs

  3. #3
    ILP
    ILP est déconnecté
    Membre confirmé
    Avatar de ILP
    Homme Profil pro
    Analyste programmeur
    Inscrit en
    Mai 2002
    Messages
    258
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 38
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : Analyste programmeur
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Mai 2002
    Messages : 258
    Points : 607
    Points
    607
    Par défaut
    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

  4. #4
    ILP
    ILP est déconnecté
    Membre confirmé
    Avatar de ILP
    Homme Profil pro
    Analyste programmeur
    Inscrit en
    Mai 2002
    Messages
    258
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 38
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : Analyste programmeur
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Mai 2002
    Messages : 258
    Points : 607
    Points
    607
    Par défaut
    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.

  5. #5
    Expert éminent sénior
    Avatar de ShaiLeTroll
    Homme Profil pro
    Développeur C++\Delphi
    Inscrit en
    Juillet 2006
    Messages
    13 429
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 42
    Localisation : France, Seine Saint Denis (Île de France)

    Informations professionnelles :
    Activité : Développeur C++\Delphi
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Juillet 2006
    Messages : 13 429
    Points : 24 794
    Points
    24 794
    Par défaut
    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, ...
    Aide via F1 - FAQ - Guide du développeur Delphi devant un problème - Pensez-y !
    Attention Troll Méchant !
    "Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson" Confucius
    Mieux vaut se taire et paraître idiot, Que l'ouvrir et de le confirmer !
    L'ignorance n'excuse pas la médiocrité !

    L'expérience, c'est le nom que chacun donne à ses erreurs. (Oscar Wilde)
    Il faut avoir le courage de se tromper et d'apprendre de ses erreurs

  6. #6
    Membre émérite

    Homme Profil pro
    Développeur informatique
    Inscrit en
    Novembre 2007
    Messages
    3 381
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 62
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Activité : Développeur informatique

    Informations forums :
    Inscription : Novembre 2007
    Messages : 3 381
    Points : 2 995
    Points
    2 995
    Par défaut
    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.

  7. #7
    Expert éminent sénior
    Avatar de ShaiLeTroll
    Homme Profil pro
    Développeur C++\Delphi
    Inscrit en
    Juillet 2006
    Messages
    13 429
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 42
    Localisation : France, Seine Saint Denis (Île de France)

    Informations professionnelles :
    Activité : Développeur C++\Delphi
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Juillet 2006
    Messages : 13 429
    Points : 24 794
    Points
    24 794
    Par défaut
    Sérialiser en chaine pour ensuite désérialiser pour faire un Assign n'est-ce pas un peu lourd ?
    en XE2, il n'y a que le Data.DBXJSON.TJSONObject qui a été revu et amélioré dans System.JSON.TJSONObject de XE7

    Pense à faire hériter de TPersistent ou de mettre la classe explicitement en M+, c'est nécessaire pour que le published fonctionne

    Avant même le JSON, il existait déjà la sérialisation d'objet mais à partir de l'héritage d'un TComponent avec TStream.ReadComponent et TStream.WriteComponent qui n'est plus ni plus ni moins le format DFM !

    Citation Envoyé par Papy214 Voir le message
    Et ça fonctionne aussi sur les propriétés enum
    Même contrainte, uniquement les enums
    Normalement, on a une erreur "E2134: Le type '%s' n'a pas d'information de type (Delphi)"
    Mais en XE, juste cela laisse 0 comme valeur de l'enum
    et en XE7 c'est une violation d'accès sur une enum sans RTTI

    Pour ceux qui n'ont que XE2, voici cela donne

    XE2 {"type":"Unit8.TForm8.TTest","id":1,"fields":{"Frtt":"trDeux"}} !
    XE7 {"rtt":"trDeux"} !

    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
    unit ZooShaiVCL_JSON;
     
    interface
     
    uses
      Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
      Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Data.DBXJSON, Data.DBXJSONReflect;
     
    type
      TZooShaiVCLJSONForm = class(TForm)
        btnObjectToJSON: TButton;
        Memo: TMemo;
        procedure btnObjectToJSONClick(Sender: TObject);
      public
        type
          TRtt = (trUn, trDeux, trTrois);
     
          TTest = class(TPersistent)
          private
            Frtt: Trtt;
          published
            property Rtt: Trtt read Frtt write Frtt;
          end;
      end;
     
    var
      ZooShaiVCLJSONForm: TZooShaiVCLJSONForm;
     
    implementation
     
    {$R *.dfm}
     
    type
      TSLTJSONConverter = class(TJSONUnMarshal)
      public
        class function JsonStringToObject<T: class>(AJson: string): T; 
        class function ObjectToJsonString(AObject: TObject): string;
      end;
     
    procedure TZooShaiVCLJSONForm.btnObjectToJSONClick(Sender: TObject);
    var
      Test: TTest;
      S: string;
    begin
      Test := TTest.Create;
      Test.Rtt := Trtt.trDeux;
      S := TSLTJSONConverter.ObjectToJsonString(Test);
      Test.Free;
      Memo.Lines.Add(S);
     
      Test := TSLTJSONConverter.JsonStringToObject<TTest>(S);
      Memo.Lines.Add(IntToStr(Ord(Test.Rtt)));
     
      Test.Free;
    end;
     
    class function TSLTJSONConverter.JsonStringToObject<T>(AJson: string): T;
    var
      LJSONValue: Data.DBXJSON.TJsonValue;
      LJSONObject: Data.DBXJSON.TJSOnObject;
      LUnMarshaler: TSLTJSONConverter;
    begin
      LJSONValue := Data.DBXJSON.TJSOnObject.ParseJSONValue(AJson);
      try
        if assigned(LJSONValue) and (LJSONValue is TJSOnObject) then
          LJSONObject := LJSONValue as TJSOnObject
        else
          Abort;
     
        LUnMarshaler := TSLTJSONConverter.Create;
        try
          Result := LUnMarshaler.CreateObject(LJSONObject) as T;
        finally
          FreeAndNil(LUnMarshaler);
        end;
      finally
        FreeAndNil(LJSONObject);
      end;
    end;
     
    class function TSLTJSONConverter.ObjectToJsonString(AObject: TObject): string;
    var
      LMarshaler: Data.DBXJSONReflect.TJSONMarshal;
      LJSONObject: TJSOnObject;
    begin
      LMarshaler := Data.DBXJSONReflect.TJSONMarshal.Create(TJSONConverter.Create);
      try
        LJSONObject := LMarshaler.Marshal(AObject) as TJSOnObject;
        try
          Result := LJSONObject.ToString;
        finally
          FreeAndNil(LJSONObject);
        end;
      finally
        FreeAndNil(LMarshaler);
      end;
    end;
     
    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
     
    object ZooShaiVCLJSONForm: TZooShaiVCLJSONForm
      Left = 326
      Top = 114
      Caption = 'JSON'
      ClientHeight = 192
      ClientWidth = 288
      Color = clBtnFace
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Tahoma'
      Font.Style = []
      OldCreateOrder = False
      DesignSize = (
        288
        192)
      PixelsPerInch = 96
      TextHeight = 13
      object btnObjectToJSON: TButton
        Left = 8
        Top = 8
        Width = 146
        Height = 25
        Caption = 'btnObjectToJSON'
        TabOrder = 0
        OnClick = btnObjectToJSONClick
      end
      object Memo: TMemo
        Left = 8
        Top = 39
        Width = 272
        Height = 145
        Anchors = [akLeft, akTop, akRight, akBottom]
        Lines.Strings = (
          'Memo')
        TabOrder = 1
        WordWrap = False
      end
    end
    Je crois que je vais me créer unité "Common\SLT.Common.JSON.pas" pour conserver ce petit TSLTJSONConverter pour XE2
    Aide via F1 - FAQ - Guide du développeur Delphi devant un problème - Pensez-y !
    Attention Troll Méchant !
    "Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson" Confucius
    Mieux vaut se taire et paraître idiot, Que l'ouvrir et de le confirmer !
    L'ignorance n'excuse pas la médiocrité !

    L'expérience, c'est le nom que chacun donne à ses erreurs. (Oscar Wilde)
    Il faut avoir le courage de se tromper et d'apprendre de ses erreurs

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. (MDI) creer des objet dans formulaire enfant
    Par brahim20 dans le forum VB.NET
    Réponses: 2
    Dernier message: 13/08/2010, 22h05
  2. Action copier objet dans Macro
    Par SheNigt_ dans le forum Access
    Réponses: 2
    Dernier message: 04/07/2007, 10h58
  3. Table Parents-enfants -> conception des objets dans BO 6.1.3
    Par webvince18 dans le forum Designer
    Réponses: 4
    Dernier message: 04/10/2006, 18h27
  4. [FLASH MX] Copier un MC d'un objet dans un autre
    Par hanane28 dans le forum Flash
    Réponses: 4
    Dernier message: 24/12/2004, 14h22
  5. Réponses: 3
    Dernier message: 05/05/2004, 01h39

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo