Discussion :

[l'elu]

Ba j'ai pas mis de var en public...

[Fabrice ROUXEL 1]

Bonjour.

La classe légérement modifiée:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
TImport = class (TObject)
protected
  FDateDelEcriture: TDateTime;
  FDeviseEcriture: string;
  FCompteGeneral: string;
  procedure SetDateDelEcriture(Date: TDateTime);
  procedure SetDeviseEcriture(Devise: string);
  procedure SetCompteGeneral(Compte: string);
published
  property DateDelEcriture : TDateTime read FDateDelEcriture write   SetDateDlEcriture;
  property DeviseEcriture: string read FDeviseEcriture write SetDeviseEcriture;
  property CompteGeneral: string read FCompteGeneral write SetCompteGeneral;
...

Pour en revenir aux RTTI, une solution est de lister chaque propriétée, trouver son type et lui affecter une valeur.
En supposant que la valeur de la propriété est également représentée par une chaine dans le document XML.

Code :

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

1
2
3
4
5
6
7
8
9
10
var ImportObj: TImport ;
....
 
procedure WriteObjFromXml(obj: TImport);
begin
if IsPublishedProp(TObject(Obj), 'CompteGeneral') then
    if PropIsType(TObject(Obj), 'CompteGeneral', tkWString) then
      SetWideStrProp(TObject(Obj), 'CompteGeneral','ValeurCompteGeneral');
 
.....

[sjrd]

Mais utilisez les RTTI ! Elles sont faites pour ça. N'allez pas chercher ailleurs.

Dans TypInfo.pas tu as des routines telles que SetStringProp ou SetOrdProp etc. Et même une qui fonctionne à base de variants.

C'est beaucoup plus simple. Il suffit de déclarer tes propriétés published, et tout le travail est fait.

N'évitez pas ce qui fait la grandeur du Delphi. Un programmeur C++ devrait mettre en place un système compliqué de persistence en plusieurs jour. Un programmeur Delphi doit écrire un mot et tout est à sa portée.

[Clorish]

Si j'ai bien compris ce que tu dis

pas du tout

Moi je disais juste que dans ton fichier XML tu as bien quelque part d'ecrit le mot "DeviseEcriture", "CompteGeneral", etc ...

Peut tu remplacer ces mots par un entier ? (dans le fichier XML)

Si oui j'ai des solutions.

Ba j'ai pas mis de var en public...

Simple information sur la technique de codage.

[Clorish]

Mais utilisez les RTTI ! Elles sont faites pour ça. N'allez pas chercher ailleurs.

Certes mais je pense que dans bien des cas on peut s'en passer pour pas franchement plus compliqué.
On propose souvent les RTTI a des gens dont le probleme est plus du a une mauvaise organisation de leur code plutot qu'a une serie de contrainte de cahier des charges

Surtout quand on est dans le cas preci de l'elu ou les property sont connu.
J'utiliserais plutot les RTTI dans le cadre d'analyse de composant ou de classes dont on ne connait pas la definition exacte .... ou pour des traitements generiques sur des classes heterogenes.

[sjrd]

Il semble bien que l'elu soit devant un problème de persistence des données. Pour rappel, c'est précisément dans cette optique que Delphi utilise les RTTI (enfin la couche visible de celles-ci) dans ces DFM.

Alors je ne pense pas que ce soit un problème de conception

[Clorish]

Il semble bien que l'elu soit devant un problème de persistence des données. Pour rappel, c'est précisément dans cette optique que Delphi utilise les RTTI (enfin la couche visible de celles-ci) dans ces DFM.

Alors je ne pense pas que ce soit un problème de conception

Possible ... qu'entends tu par persistance ?
J'aurais plutot pensé a un bete fichier de config.

[CapJack]

S'il est vrai qu'il s'agit d'un simple problème de sauvegarde/récupération de données, je dis sans doute une grosse bêtise, mais il me semble qu'il y a un moyen extrêmement simple de sauvegarder et de lire les propriétés publiées d'un objet : en utilisant les objets TWriter et TReader : ils ont été créés pour ça.

Seul problème : le fichier obtenu est alors un fichier binaire, et plus un fichier texte, ce qui rend sa lecture et sa modification manuelles impossibles.

[Clorish]

S'il est vrai qu'il s'agit d'un simple problème de sauvegarde/récupération de données, je dis sans doute une grosse bêtise, mais il me semble qu'il y a un moyen extrêmement simple de sauvegarder et de lire les propriétés publiées d'un objet : en utilisant les objets TWriter et TReader : ils ont été créés pour ça.

Seul problème : le fichier obtenu est alors un fichier binaire, et plus un fichier texte, ce qui rend sa lecture et sa modification manuelles impossibles.

Oui il existe bien d'autres formats aussis
Mais a la vue du format (XML) qui n'est pas des plus courrant et des plus pratique pour gerer un fichier de config, le format et a fortiori le style des données (en clair) est un imperatif.

[Pascal Jankowski]

A propos de la persistence et de RTTI, un petit tuto pratique à cet endroit

Deux unités à downloder en bas de la page suivante, devrait aider l'elu

[Paul TOTH]

je vois deux solutions simples

mais d'abord voici le code qu'on veux utiliser

Code :

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

1
2
3
4
5
6
7
8
9
 
procedure TForm1.FormCreate(Sender: TObject);
var
 o:TMonObject;
begin
 o:=TMonObject.Create;
 o.SetProp('Test','Hello');
 ShowMessage(o.Test);
end;

Première méthode avec un Setter

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
 
type
 TMonObject=class
 private
  fTest:string;
 public
  procedure SetProp(Name:string; Value:Variant);
 published
  procedure SetTest(Value:string);
  property Test:string read fTest;
 end;
{$M-}
 
procedure TMonObject.SetTest(Value:string);
begin
 fTest:=Value;
end;
 
procedure TMonObject.SetProp(Name,Value:string);
var
 p:procedure(This:TObject; Value:string);
begin
 @p:=MethodAddress('Set'+Name);
 if @p<>nil then p(Self,Value);
end;

la seule contrainte est ici d'avoir un SetXXX pour publié pour chaque propriété...

deuxième solution, les RTTI, et là c'est ultra simple

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
 
uses
 TypInfo;
 
type
{$M+}
 TMonObject=class
 private
  fTest:string;
 public
  procedure SetProp(Name:string; Value:Variant);
 published
  property Test:string read fTest write fTest;
 end;
{$M-}
 
procedure TMonObject.SetProp(Name:string; Value:Variant);
begin
 SetPropValue(Self,Name,Value);
end;

ici, la propriété publiée DOIT avoir un Setter, mais son type est libre
Notez l'ajout de l'unité TypInfo et du {$M+} autour de l'object qui n'est pas ici un descendant de TPersistent (qui possède également cet attribut).

[ShaiLeTroll]

Est-ce que quelqu'un connait InstantObject, j'ai vu les sources, mais je ne l'ai jamais utilisé, peut-être qu'il est possible de développer un Provider alimenté par un XML ... peut-être en passant par un TClientDataSet ...

Sinon comme je l'ai mentionné dans ce sujet, ayant développez une couche de persistance au bureau, ton XML pourrait être transformé via un XSL (TXMLDocument.TransformNode ?) en une DFM (nous le faisons car nous générons des DFM à partir de XML issu d'un formulaire php) que tu peux aspirer facilement avec les fonctions fournis dans l'aide de Delphi à base de ObjectTextToBinary et Stream.ReadComponent

Ensuite quand je vois ceci, je bondis !

Code :

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

1
2
3
4
TImport = class (TObject)
...
published
...

Si il n'y pas la Directive M+ ou tout simplement un héritage depuis un TComponent/TPersistent, comment voulez-vous avoir du RTTI ... car un TObject n'a pas de RTTI !!!

EDIT : Merde, Paul TOTH m'a grillé pour le M+ ...

EDIT 2 :

la seule contrainte est ici d'avoir un SetXXX pour publié pour chaque propriété...

effectivement, certains objets métiers ayant plus de 100 variables cela devient fastidieux (le top est un XML de description et un programme qui utilise des XSL pour générer du code et l'insérer dans des templates ...)

on peut aussi ne pas mettre de variable privé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
25
26
27
28
29
30
31
32
33
34
 
   TFieldIndividu =
     (
       flClassName,
       finom_jf, finom, fiD_CREATION, fiprenom, finss, fiddn, ficp, fidept, fiSexe, ficommune_naissance, ficp_naiss, fiadresse, finir, fiville
     );
 
TObjectIndividu = class(TEpcPersistant)
  private
  protected
    { Méthodes d'Acces }
    function GetLesions(): TEpcPersistantRelation;
  public
    { Méthodes Publiques }
...
    { proprités Publiques }
    property Lesions: TEpcPersistantRelation read GetLesions;
  published
    { Propriétés Publiées }
    property nom_jf : Variant index finom_jf  read GetData write SetData;
    property nom : Variant index finom  read GetData write SetData;
    property D_CREATION : Variant index fiD_CREATION  read GetData write SetData;
    property prenom : Variant index fiprenom  read GetData write SetData;
    property nss : Variant index finss  read GetData write SetData;
    property ddn : Variant index fiddn  read GetData write SetData;
    property cp : Variant index ficp  read GetData write SetData;
    property dept : Variant index fidept  read GetData write SetData;
    property Sexe : Variant index fiSexe  read GetData write SetData;
    property commune_naissance : Variant index ficommune_naissance  read GetData write SetData;
    property cp_naiss : Variant index ficp_naiss  read GetData write SetData;
    property adresse : Variant index fiadresse  read GetData write SetData;
    property nir : Variant index finir  read GetData write SetData;
    property ville : Variant index fiville  read GetData write SetData;
  end;

Bon, évidemment, vous pouvez imaginez que tout vient du TEpcPersistant (environ 10 unités, ~10000 lignes + Abstracteur MySQL 5000 lignes)

avec ce genre de chose, les truc intéressants sont par exemple FData qui stocke TOUTES les valeurs ... les Variants peuvent être chiant à manipuler (cast sur null), mais dans en gérant un PropertyType (les objets pouvant être décrit par un XML, ce dernier décrivant aussi la structure des tables et des relations), l'accès par défaut renvoie des valeurs neutres dans le type (0, '', ...) tout en laissant des fonctions pour tester la nullité ...

Et si l'on veut un pré-traitement, il suffit de surcharger SetData et il sera pour toutes les property, ou faire un SetXXXData spécifique pour certaines propriétés, ... mais le mieux serait de décrire des règles pour certaines propriétés et que dans le SetData du TEpcPersistant, on puisse appeler en comme la méthode IsCompatiblePropertyType, une méthode IsWorkFlowPropertyGoodNewValue qui vérifie la cohérence métier ...

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
  TEpcPersistantPropertyData = record
    OldValue: Variant;
    NewValue: Variant;
    PropertyType: Pointer; // via la Function TypeInfo(...);
    Changed: Boolean;
    Name: string;
  end;
  TEpcPersistantPropertyDataList = array of TEpcPersistantPropertyData;
 
...
 
  TEpcPersistant = class(TComponent)
  private
    { Membres Privés }
    FTableName: string; /// Champ Interne, cf TableName
    FID: TepcPersistantIDType; /// Champ Interne, cf ID
    FIDName: string; /// Champ Interne, cf IDName
    FRelations: array of TEpcPersistantRelation; /// Champ Interne, cf Relations
    FRelationsToDo: TList;
    FData: TEpcPersistantPropertyDataList;
    FCollection: TEpcPersistantCollection;
    { Méthodes Privés }
    procedure _Initialize();
    procedure _Finalize();
    function AddRelationToDo(const RelationTableName: string; Master: TEpcPersistant; out ToDo: Pointer): Boolean;
    function AddRelationToSave(const RelationTableName: string; Master: TEpcPersistant): Boolean; overload;
    function AddRelationToSave(Relation, Master: TEpcPersistant): Boolean; overload;
    function AddRelationToDelete(const RelationTableName: string; Master: TEpcPersistant): Boolean;
    function AlterRelation(): Boolean;
    procedure InternalLoad(const NewID: TepcPersistantIDType);
    procedure InternalSave();
    function GetPropertyIndex(const PropertyName: string): Integer;
    function GetPropertyName(const Index: Integer): string;
    function GetPropertyData(const PropertyName: string): TEpcPersistantPropertyData;
    function RemoveCollection(): TEpcPersistantCollection;
    class function CreateCollection(): TEpcPersistantCollection;
    class function GetRelationDescription(const PersistantClass: TEpcPersistantClass): PEpcPersistantRelationDescription;
    class procedure CleanComponentProperties(List: TStrings);
  protected
    { Méthodes d'Accès }
    function GetItSelf(): TEpcPersistant;
    function GetPersistantClass: TEpcPersistantClass;
    function GetPersistantClassName: string;
    function GetRelations(const PersistantClass: TEpcPersistantClass): TEpcPersistantRelation;
    function GetPublishedProperty(const PropertyName: string): Variant;
    procedure SetPublishedProperty(const PropertyName: string; Value: Variant);
    function GetPublishedPropertyIsNull(const PropertyName: string): Boolean;
    function GetPublishedPropertyChanged( const PropertyName: string): Boolean;
    function GetPublishedPropertyType(const PropertyName: string): Pointer;
    function GetPublishedPropertyVarType(const PropertyName: string): TVarType;
    function GetIsAncestorClass: Boolean;
    function GetChanged: Boolean;
    { Méthodes d'Accès pour les Propriétés Indicées }
    function GetData(const Index: Integer): Variant; virtual;
    procedure SetData(const Index: Integer; const Value: Variant); virtual;
    { Propriétés Protégées }
    property Data[const Index : Integer]: Variant read GetData write SetData;
    { Propriétés Protégées à Publier !}
    property Relations[const PersistantClass: TEpcPersistantClass]: TEpcPersistantRelation read GetRelations;
  public
    { Constructeurs }
    constructor Create(AOwner: TComponent); overload; override;
    constructor Create(); reintroduce; overload; virtual;
    destructor Destroy; override; /// Destructeur surchargé d'un TComponent
    { Méthodes Publiques }
    procedure Assign(Source: TPersistent); overload; override;
    procedure Assign(Source: TPersistent; const Exclude: TStrings); reintroduce; overload; virtual;
    procedure AssignTo(Dest: TPersistent); overload; override;
    procedure AssignTo(Dest: TPersistent; const Exclude: TStrings); reintroduce; overload; virtual;
    class function Active: Boolean;
    class procedure RegisterMe();
    class function IsDebugger(): Boolean;
    class function Initialize(const XMLFileName: string; const OnInitialize: TPersistantInitializeEvent = nil): Boolean;
    class function InitializeBooleanValues(LocalIndex: Integer; const ATrueBoolStrs: array of string; const AFalseBoolStrs: array of string): Boolean;
    class function FindHerited(const ClassName: string): TEpcPersistantClass;
    class function PropertyCount: Integer;
    class function GetProperties(List: TStrings): Boolean;
    class function IsPublishedProperty(const PropertyName: string): Boolean;
    class function Load(const ID: TepcPersistantIDType): TEpcPersistant; overload;
    class function Load(const Keys: array of string; const Values: array of Variant): TEpcPersistant; overload;
    class function Load(Location: TPersistantProcLocation; const ProcName: string; const Values: array of const): TEpcPersistant; overload;
    class function Select(const Keys: array of string; const Values: array of Variant; OnlyOne: Boolean = False): TEpcPersistantCollection; overload;
    class function Select(const Keys: array of string; const Values: array of Variant; OnlyOne: Boolean; const Operators: array of TRelationalOperatorType): TEpcPersistantCollection; overload;
    class function Select(Location: TPersistantProcLocation; const ProcName: string; const Values: array of const; Index: Integer = 1; OnlyOne: Boolean = False): TEpcPersistantCollection; overload;
    function Fill(const Data: TDataSet): Boolean;
    function Save(): Boolean;
    function Delete(Cascade: Boolean = False): Boolean;
    function ToComponentString(): string;
    class function ComponentStringTo(Value: string): TEpcPersistant;
    class function RealAssigned(var Obj): Boolean;
    function StringToProperty(const PropertyName: string; const Value: string): Variant;
    function PropertyToString(const PropertyName: string): string;
    { Propriétés Publiques }
    property ItSelf: TEpcPersistant read GetItSelf;
    property TableName: string read FTableName; /// Nom de la Table Associée aux Persistants
    property ID: TepcPersistantIDType read FID; /// Identifiant Clé Primaire AutoIncrémenté Unique
    property IDName: string read FIDName; /// Nom de la Clé Primaire normalement "ID_TableName"
    property PersistantClass: TEpcPersistantClass read GetPersistantClass; /// Classe du Persistant
    property PropertyName[const Index: Integer]: string read GetPropertyName;
    property PublishedProperty[const PropertyName: string]: Variant read GetPublishedProperty write SetPublishedProperty;
    property PublishedPropertyIsNull[const PropertyName: string]: Boolean read GetPublishedPropertyIsNull;
    property PublishedPropertyChanged[const PropertyName: string]: Boolean read GetPublishedPropertyChanged;
    property PublishedPropertyType[const PropertyName: string]: Pointer read GetPublishedPropertyType;
    property PublishedPropertyVarType[const PropertyName: string]: TVarType read GetPublishedPropertyVarType;
    property IsAncestorClass: Boolean read GetIsAncestorClass; /// Classe utilisée comme Ancêtre ?
    property Changed: Boolean read GetChanged;
  published
    { Propriétés Publiées }
    property PersistantClassName: string read GetPersistantClassName; /// cf constante FIELD_CLASS_NAME
  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
{* -----------------------------------------------------------------------------
Accesseur de Data
@param Index Spécificateur d'Indice la Propriété Tableau
@return Valeur Courante
------------------------------------------------------------------------------ }
function TEpcPersistant.GetData(const Index: Integer): Variant;
begin
  if Index = 0 then
    Result := Self.PersistantClassName
  else
  begin
    Result := Unassigned;
    if VarIsNull(FData[Index].NewValue) or VarIsEmpty(FData[Index].NewValue) then
      Result := TEpcPersistantClassManager.Manager.GetPropertyDefaultValue(FData[Index].PropertyType)
    else
      Result := VarAsType(FData[Index].NewValue, TEpcPersistantClassManager.Manager.GetPropertyVarType(FData[Index].PropertyType));
  end;
end;
 
{* -----------------------------------------------------------------------------
Accesseur de Data
@param Index Spécificateur d'Indice la Propriété Tableau
@param Value Nouvelle Valeur
------------------------------------------------------------------------------ }
procedure TEpcPersistant.SetData(const Index: Integer; const Value: Variant);
var
  CastValue: Variant;
begin
  if Index = 0 then
    Exit;
 
  if VarIsEmpty(Value) then
    Exit;
 
  if VarIsEmpty(FData[Index].OldValue) and (TEpcPersistantDBProvider.Provider.LoadingObject = Self) then
  begin
    FData[Index].OldValue := Value;
    FData[Index].NewValue := Value;
  end else
  begin
    // Le Type est bien le Type de la Propriété ou alors c'est Null
    if TEpcPersistantClassManager.IsCompatiblePropertyType(FData[Index].PropertyType, Value, True) then
    begin
      // Gestion du Nulle et du Vide ...
      if (VarIsNull(FData[Index].NewValue) and not VarIsNull(Value)) // Actuelle Nulle et Nouvelle Pas Nulle
      or (not VarIsNull(FData[Index].NewValue) and VarIsNull(Value)) // Actuelle Pas Nulle et Nouvelle Nulle
      or VarIsEmpty(FData[Index].NewValue) then                      // Actuelle Vide (Create au lieu de Load, par exemple)
      begin
        if VarIsNull(Value) then
           FData[Index].NewValue := Null
        else
          FData[Index].NewValue := VarAsType(Value, TEpcPersistantClassManager.GetPropertyVarType(FData[Index].PropertyType));
        FData[Index].Changed := True;
      end else
      begin
        // Soit Actuelle et Nouvelle sont Nulles, donc rien à faire ...
        // Soit Actuelle et Nouvelle ne sont pas Nulles, faut comparer et affecter si différentes
        if not VarIsNull(Value) then
        begin
          try
            // Le Type est compatible, on convertit pour que le type de la Valeur soit précisément le type défini par le XML (Ex Double <> Currency)
            CastValue := VarAsType(Value, TEpcPersistantClassManager.GetPropertyVarType(FData[Index].PropertyType));
          except
            on Exception do
              raise EPropertyError.CreateFmt(ERR_SET_DIFFERENT_TYPE_VALUE, [GetPropertyName(Index), Self.ClassName, VarTypeAsText(VarType(FData[Index].NewValue)), VarTypeAsText(VarType(Value))]);
          end;
 
          if (FData[Index].NewValue <> CastValue) then
          begin
            FData[Index].NewValue := CastValue;
            FData[Index].Changed := True;
          end;
        end;
      end;
    end else
      raise EPropertyError.CreateFmt(ERR_SET_INVALID_TYPE_VALUE, [GetPropertyName(Index), Self.ClassName, VarTypeAsText(TEpcPersistantClassManager.Manager.GetPropertyVarType(FData[Index].PropertyType)), TEpcPersistantClassManager.Manager.GetPropertyTypeName(FData[Index].PropertyType), VarTypeAsText(VarType(Value))]);
  end;
end;

Voilà c'est du code en vrac, mais cela peut donner des idées, et montrer que dès qu'on se lance dans de la persistance on peut aller TRES TRES loin ... voire comme moi, trop loin, et pourtant, j'ai encore plein d'idées qui m'éclaterait bien à coder ... mais finalement après à l'utilisation, cela devient tellement objet que c'est rejeté par bcp de mes collègues ... mais c'était fun ...

[Fabrice ROUXEL 1]

{$M+} si la classe ne dérive pas de TPersistent, afin bien sûr de mettre en place les mécanismes RTTI.
Cela parait évident mais il est bon de le rappeler.

A Paul Toth:

La première méthode exposée est intéressante(et pédagogique!), le code est plus compact et cela nous change du code à bordel que nous pondent certains illuminés.Pour ma part j'ai plutôt l'habitude de l'utiliser comme cela:

Code :

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

1
2
3
4
5
6
7
8
procedure TMonObject.SetProp(Name: string; Value: Variant);
var
  p: procedure(Value:string) of Object;
begin
 TMethod(p).Data := self;
 TMethod(p).Code := MethodAddress('Set'+Name);
 if @p<>nil then p(Value);
end;

@+

[ShaiLeTroll]

Serais-je un illuminé ? Oh Oui ! Merci du compliment

Sinon, juste comme ça ... effectivement la méthode "TMonObject.SetProp" ci dessus, c'est en gros le mécanisme des accesseurs des objets, stocké dans la table que l'on récupère via GetPropInfos, et les accesseurs sont GetProc et SetProc dans l'item PPropInfo ... mais c'est une façon intéressante de faire son propre RTTI, mais autant faire un Objet hérité de TPersistent qui avec la fonction "SetPropValue(Instance: TObject; const PropName: string; const Value: Variant);" de l'unité TypInfo qui fait exactement ce qu'on lui demande affecter à la propriété PropName la valeur value, et il gérera lui même la présence d'un accès par variable ou par accesseur ... et j'avoue que l'encapsuler dans un objet, c'est plus "joli" que l'appel procédurale lorsque l'on veut faire un code full objet, j'ai fait de même sous la forme d'une propriété PublishedProperty avec ses Get/Set...

maintenant il faut faire attention lorsque l'on utilise les variants car si l'on a une propriété de type Integer, et qu'on met une string dans le variant, il ne va pas convertir pour nous, il faut soit même faire attention au type, pour les DFM c'est pareil, suffit de voir le code de ObjectBinaryToText, sous fonction ConvertValue ... et c'est justement toute la complexité du code que j'ai mis ci-dessus.

[Paul TOTH]

@Fabrice,

oui l'utilisation d'une procedure of object est plus classique...mais ajouter Self simplifie en fait le code

@ShaiLeTroll

MethodAddr n'est pas lié aux setters, c'est plus vaste que cela. J'ai utilisé cette méthode il y a longtemps dans un contexte de langage interprété de type BASIC

Code :

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

1
2
3
4
5
6
7
8
9
 
type
 TBasicRuntime=class
 ...
 published
  procedure OpPRINT;
  procedure OpFOR;
  procedure OpGOTO;
 end;

la classe ci-dessus était utilisée pour executer du code BASIC avec un quelque chose du genre :

Code :

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

1
2
3
4
 
 p:=GetMethod('Op'+Token);
 if p=nil then Error('Unknow token '+Token);
 p(self);

[ShaiLeTroll]

Contexte de langage interprété

Effectivement, j'ai fait ce genre de chose, pour un interpréteur de calcul façon HP48Gx en notation inversé ou classique mais avec du procédural, avec un tableau constant de structure avec une chaine et un pointer de procédure ... mais les formule contenait + - / * et les méthodes c'était Plus, Minus, Div, Mul, dans ce cas le RTTI n'aurait pas fonctionné ... comment à tu résolu ce problème pour ton interpréteur BASIC avec les opérateurs ? d'ailleurs y-a-t-il des opérateurs en BASIC genre + = - < ... ?

sinon utiliser le mécanisme de publication des méthodes pour cela c'est une bonne idée que m'avait proposé Anapurna, mais je l'ai refusé à cause du problème des paramètres qui change et le fait que le RTTI réduisait le nombre d'erreur pouvant être détecté à la compilation au lieu du RunTime, c'était pour un mapping entre deux tables de l'une des applications phares de mon employeur ... bon j'ai fait ça juste pour le fun ... VOIR ICI.

[Paul TOTH]

Effectivement, j'ai fait ce genre de chose, pour un interpréteur de calcul façon HP48Gx en notation inversé ou classique mais avec du procédural, avec un tableau constant de structure avec une chaine et un pointer de procédure ... mais les formule contenait + - / * et les méthodes c'était Plus, Minus, Div, Mul, dans ce cas le RTTI n'aurait pas fonctionné ... comment à tu résolu ce problème pour ton interpréteur BASIC avec les opérateurs ? d'ailleurs y-a-t-il des opérateurs en BASIC genre + = - < ... ?

je ne sais plus c'était du Delphi 1 et ça a du passer à la poubelle mais le j'avais probablement imposé l'instruction LET

Code :

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

1
2
3
4
5
6
7
8
9
 
procedure TBasicRunTime.OpLET;
// LET var=value
begin
 v:=ParseVar;
 Drop('='); 
 e:=ParseExpr;
 SetVar(v,e);
end;

[l'elu]

Alors j'ai solutionné mon problème grâce a quelques uns de vos conseils...
Et oui la méthodes SETPROPVALUE suffit grandement pour ce que je veux faire!!
On lui donne l'objet, son nom en chaine (ce que j'ai) et la valeur (que j'ai aussi!!) donc merci a ceux qui m'avaient préconisé ca! ca marche pas mal et c'est simple!

SetPropValue(MonImport, lstcolD.item[i].selectSingleNode('./destCol').text, lstcolD.item[i].selectSingleNode('./srcCol').text);

Merci