paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-14 11:29:41 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ add methods to easily access a context token's AddObject() and GetByHandle() methods inside the Rtti unit

Browse Source 
git-svn-id: trunk@37759 -
This commit is contained in:
svenbarth 2017-12-18 20:55:21 +00:00
parent 7ad3a0f12c
commit 6c02433e1e
1 changed files with 17 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
packages/rtl-objpas/src/inc/rtti.pp
View File

@ -41,6 +41,7 @@ uses
typinfo;
type
TRttiObject = class;
TRttiType = class;
TRttiProperty = class;
TRttiInstanceType = class;
@ -143,6 +144,8 @@ type
TRttiContext = record
private
FContextToken: IInterface;
function GetByHandle(AHandle: Pointer): TRttiObject;
procedure AddObject(AObject: TRttiObject);
public
class function Create: TRttiContext; static;
procedure Free;
@ -2350,6 +2353,20 @@ begin
FContextToken := nil;
end;
function TRttiContext.GetByHandle(AHandle: Pointer): TRttiObject;
begin
if not Assigned(FContextToken) then
FContextToken := TPoolToken.Create;
Result := (FContextToken as IPooltoken).RttiPool.GetByHandle(AHandle);
end;
procedure TRttiContext.AddObject(AObject: TRttiObject);
begin
if not Assigned(FContextToken) then
FContextToken := TPoolToken.Create;
(FContextToken as IPooltoken).RttiPool.AddObject(AObject);
end;
function TRttiContext.GetType(ATypeInfo: PTypeInfo): TRttiType;
begin
if not assigned(FContextToken) then