FPC :记录RTTI
FPC :记录RTTI
提问于 2015-01-06 16:54:15
这是我第一次在这个网站上。通常，我在旧的帖子中找到回复是没有问题的，但我的实际问题并不成功。
我想知道如何在运行时使用RTTI函数来了解Lazarus/FPC下记录的属性/成员？我知道如何为类(Tpersistent后代和已发布的属性)做这件事，而不是针对FPC。一些链接表明如何在德尔菲(来自D2010)的情况下完成它，但我不知道如何在Lazarus下转换它。
提前感谢您的帮助和帮助。萨利姆·拉赫肋骨。
凯文:就像我之前说过的，这是我的第一个要求。但我明白。你是正确的。这是我的密码
procedure TMainForm.btRecordTHashListClick(Sender: TObject);
var
pTData : PTypeData;
pTInfo : PTypeInfo;
TablePtr : PatableRecord;
Loop : Integer;
begin
// Set of Record pointers + HashList
// Create Container
if not Assigned(FTableRecList) then FTableRecList := TFPHashList.Create;
// Insert data
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 );
// Read records
for Loop:=0 to FTableRecList.Count-1 do
begin
TablePtr := FTableRecList[Loop];
ShowMessage('Parcours Index : ' + TablePtr^.description);
end;
// Find records
try
TablePtr := FTableRecList.Find('ddafunction');
ShowMessage('Record finded : ' + TablePtr^.description);
except
ShowMessage('Not such record .');
end;
try
TablePtr := FTableRecList.Find('afunction');
ShowMessage('Record finded : ' + TablePtr^.description);
except
ShowMessage('No such record.');
end;
// Free memory : To put later in TFPHashList wrapper
for Loop:=0 to FTableRecList.Count-1 do Dispose(PatableRecord(FTableRecList[Loop]));
// RTTI
pTInfo := TypeInfo(TatableRecord);
pTData := GetTypeData(pTInfo);
ShowMessage('Member count = '+IntToStr(pTData^.PropCount));
end;回答 1
Stack Overflow用户
回答已采纳
发布于 2015-01-07 00:46:49
警告:它适用于FPC 2.7.1或更高版本.
您可以使用指针处理记录字段。下面是一个例子：
program rttitest;
uses
TypInfo;
type
TMyRec = record
p1: Integer;
p2: string;
end;
var
td: PTypeData;
ti: PTypeInfo;
mf: PManagedField;
p: Pointer;
f: Pointer;
r: TMyRec;
begin
r.p1 := 312;
r.p2 := 'foo-bar';
ti := TypeInfo(r);
td := GetTypeData(ti);
Writeln(td^.ManagedFldCount); // Get count of record fields
// After ManagedFldCount TTypeData contains list of the TManagedField records
// So ...
p := @(td^.ManagedFldCount); // Point to the ManagedFldCount ...
// Inc(p, SizeOf(Integer)); // Skip it (Wrong for 64-bit targets)
// Next line works for both
Inc(p, SizeOf(td^.ManagedFldCount)); // Skip it
mf := p; // And now in the mf we have data about first record's field
Writeln(mf^.TypeRef^.Name);
Write(r.p1); // Current value
f := @r;
Inc(f, mf^.FldOffset); // Point to the first field
Integer(f^) := 645; // Set field value
Writeln(r.p1); // New value
// Repeat for the second field
Inc(p, SizeOf(TManagedField));
mf := p;
Writeln(mf^.TypeRef^.Name);
Write(r.p2);
f := @r;
Inc(f, mf^.FldOffset);
string(f^) := 'abrakadabra';
Writeln(r.p2);
Readln;
end.页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/27803383
复制相关文章
相似问题
腾讯云开发者
