paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 22:49:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

Implemented get/setinterfaceproperty. Needs checking

Browse Source 
git-svn-id: trunk@9597 -
This commit is contained in:
michael 2007-12-30 22:01:53 +00:00
parent d7f94a8282
commit a375df54f2
1 changed files with 40 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
rtl/objpas/typinfo.pp
View File

@ -280,6 +280,10 @@ Function GetVariantProp(Instance: TObject; const PropName: string): Variant;
Procedure SetVariantProp(Instance: TObject; const PropName: string; const Value: Variant);
Procedure SetVariantProp(Instance: TObject; PropInfo : PPropInfo; const Value: Variant);
function GetInterfaceProp(Instance: TObject; const PropName: string): IInterface;
function GetInterfaceProp(Instance: TObject; PropInfo: PPropInfo): IInterface;
procedure SetInterfaceProp(Instance: TObject; const PropName: string; const Value: IInterface);
procedure SetInterfaceProp(Instance: TObject; PropInfo: PPropInfo; const Value: IInterface);
// Auxiliary routines, which may be useful
Function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
@ -1089,6 +1093,42 @@ begin
Result:=GetTypeData(FindPropInfo(Instance,PropName)^.PropType)^.ClassType;
end;
{ ---------------------------------------------------------------------
Interface wrapprers
---------------------------------------------------------------------}
function GetInterfaceProp(Instance: TObject; const PropName: string): IInterface;
begin
Result:=GetInterfaceProp(Instance,FindPropInfo(Instance,PropName));
end;
function GetInterfaceProp(Instance: TObject; PropInfo: PPropInfo): IInterface;
begin
{$ifdef cpu64}
Result:=IInterface(GetInt64Prop(Instance,PropInfo));
{$else cpu64}
Result:=IInterface(PtrInt(GetOrdProp(Instance,PropInfo)));
{$endif cpu64}
end;
procedure SetInterfaceProp(Instance: TObject; const PropName: string; const Value: IInterface);
begin
SetInterfaceProp(Instance,FindPropInfo(Instance,PropName),Value);
end;
procedure SetInterfaceProp(Instance: TObject; PropInfo: PPropInfo; const Value: IInterface);
begin
{$ifdef cpu64}
SetInt64Prop(Instance,PropInfo,Int64(Value));
{$else cpu64}
SetOrdProp(Instance,PropInfo,Integer(Value));
{$endif cpu64}
end;
{ ---------------------------------------------------------------------
String properties