[Lazarus] RTTI sur record

Bonjour,
Je souhaite savoir s'il est possible de connaitre les propriétés d'un record à l'exécution de l'application. Les commandes fonctionnent bien pour une classe mais je n'ai pas trouvé comment faire pour un enregistrement. Voici mon code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
procedure TMainForm.btRecordTHashListClick(Sender: TObject);
var
  pTData	: PTypeData;
  pTInfo	: PTypeInfo;
  TablePtr	: PatableRecord;
  Loop		: Integer;
begin
  // Combinaison  Pointeur d'enregistrmenet(Record) + Liste de pointeurs (TFPHashList)
 
  // Creation de liste
  if  not Assigned(FTableRecList) then FTableRecList := TFPHashList.Create;
 
  // Insertion de données
  new(TablePtr);
  TablePtr^.description := 'Dictionnaire des tables.';
  FTableRecList.add('atable', TablePtr );
 
  new(TablePtr);
  TablePtr^.description := 'Dictionnaire des fonctions.';
  FTableRecList.add('afunction', TablePtr );
 
  new(TablePtr);
  TablePtr^.description := 'Dictionnaire des listes d''option.';
  FTableRecList.add('alist', TablePtr );
 
  // Lecture des donnÃ©es
  for Loop:=0 to FTableRecList.Count-1 do
  begin
    TablePtr := FTableRecList[Loop];
    ShowMessage('Parcours Index : ' + TablePtr^.description);
  end;
 
  // Recherchde des données
  try
    TablePtr := FTableRecList.Find('ddafunction');
    ShowMessage('Recherche réussie : ' + TablePtr^.description);
  except
    ShowMessage('Clé introuvable.');
  end;
  try
    TablePtr := FTableRecList.Find('afunction');
    ShowMessage('Recherche réussie : ' + TablePtr^.description);
  except
    ShowMessage('Clé introuvable.');
  end;
 
  // Liberation des données : A integrer dans wrapper TFPHashList
  for Loop:=0 to FTableRecList.Count-1 do Dispose(PatableRecord(FTableRecList[Loop]));
 
  // RTTI
  pTInfo := TypeInfo(TatableRecord);
  pTData := GetTypeData(pTInfo);
 
  ShowMessage('Nombre de propriétés = '+IntToStr(pTData^.PropCount));
 
end;

Voici la déclaration du type

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
  PatableRecord  = ^TatableRecord;
  {$M+}
  TatableRecord = object
  private
    Fatbnum      : ShortString;         // Code de la table
    Ftabledb     : ShortString;          // Dénomination de la table
    Fatbnam      : ShortString;          // Libéllé
    Fdescription : String;              // Description de la table
    Fversion     : Integer;             // Version lock
    Fflgsystem   : Boolean;             // Flag table systeme
    Fcredate     : TDate;               // Date création
    Fcreuser     : ShortString;           // Opérateur création
    Fupddate     : TDate;               // Date modification
    Fupduser     : ShortString;           // Opérateur modification
    Frowid       : Integer;             // ID Ligne
  published
    property atbnum      : ShortString		read Fatbnum       write Fatbnum;
    property tabledb     : ShortString		read Ftabledb      write Ftabledb;
    property atbnam      : ShortString		read Fatbnam       write Fatbnam;
    property description : String			read Fdescription  write Fdescription;
    property version     : Integer			read Fversion      write Fversion;
    property flgsystem   : Boolean			read Fflgsystem    write Fflgsystem;
    property credate     : TDate			read Fcredate      write Fcredate;
    property creuser     : ShortString		read Fcreuser      write Fcreuser;
    property upddate     : TDate			read Fupddate      write Fupddate;
    property upduser     : ShortString		read Fupduser      write Fupduser;
    property rowid       : Integer			read Frowid        write Frowid;
  end;
  {$M-}

Le même code avec un type TTable = class(TInterfacedObject) puis TypeInfo(TTable.classInfo) fonctionne a merveille.

Merci de votre aide.
Salutations.