paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 07:26:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

* use NameIndex in GetPropInfos

Browse Source 
git-svn-id: trunk@2004 -
This commit is contained in:
peter 2005-12-20 10:35:08 +00:00
parent ff1f800de5
commit 6238b1a917
1 changed files with 24 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
rtl/objpas/typinfo.pp
View File

@ -138,7 +138,7 @@ unit typinfo;
RawIntfFlags : TIntfFlagsBase; RawIntfFlags : TIntfFlagsBase;
IID: TGUID; IID: TGUID;
RawIntfUnit: ShortString; RawIntfUnit: ShortString;
IIDStr: ShortString; IIDStr: ShortString;
); );
end; end;
@ -288,19 +288,19 @@ Type
EPropertyError = Class(Exception); EPropertyError = Class(Exception);
TGetPropValue = Function (Instance: TObject; const PropName: string; PreferStrings: Boolean) : Variant; TGetPropValue = Function (Instance: TObject; const PropName: string; PreferStrings: Boolean) : Variant;
TSetPropValue = Procedure (Instance: TObject; const PropName: string; const Value: Variant); TSetPropValue = Procedure (Instance: TObject; const PropName: string; const Value: Variant);
TGetVariantProp = Function (Instance: TObject; PropInfo : PPropInfo): Variant; TGetVariantProp = Function (Instance: TObject; PropInfo : PPropInfo): Variant;
TSetVariantProp = Procedure (Instance: TObject; PropInfo : PPropInfo; const Value: Variant); TSetVariantProp = Procedure (Instance: TObject; PropInfo : PPropInfo; const Value: Variant);
Const Const
OnGetPropValue : TGetPropValue = Nil; OnGetPropValue : TGetPropValue = Nil;
OnSetPropValue : TSetPropValue = Nil; OnSetPropValue : TSetPropValue = Nil;
OnGetVariantprop : TGetVariantProp = Nil; OnGetVariantprop : TGetVariantProp = Nil;
OnSetVariantprop : TSetVariantProp = Nil; OnSetVariantprop : TSetVariantProp = Nil;
Implementation Implementation
uses rtlconsts; uses rtlconsts;
type type
PMethod = ^TMethod; PMethod = ^TMethod;
@ -369,7 +369,7 @@ begin
PT:=GetTypeData(enum1); PT:=GetTypeData(enum1);
Count:=0; Count:=0;
Result:=0; Result:=0;
PS:=@PT^.NameList; PS:=@PT^.NameList;
While (PByte(PS)^<>0) do While (PByte(PS)^<>0) do
begin begin
@ -600,25 +600,24 @@ Var
TP : PPropInfo; TP : PPropInfo;
Count : Longint; Count : Longint;
begin begin
TD:=GetTypeData(TypeInfo); repeat
// Get this objects TOTAL published properties count TD:=GetTypeData(TypeInfo);
TP:=aligntoptr(PPropInfo(aligntoptr((@TD^.UnitName+Length(TD^.UnitName)+1)))); // Get this objects TOTAL published properties count
Count:=PWord(TP)^; TP:=aligntoptr(PPropInfo(aligntoptr((@TD^.UnitName+Length(TD^.UnitName)+1))));
// Now point TP to first propinfo record. Count:=PWord(TP)^;
Inc(Pointer(TP),SizeOF(Word)); // Now point TP to first propinfo record.
tp:=aligntoptr(tp); Inc(Pointer(TP),SizeOF(Word));
While Count>0 do tp:=aligntoptr(tp);
begin While Count>0 do
PropList^[0]:=TP; begin
Inc(Pointer(PropList),SizeOf(Pointer)); PropList^[TP^.NameIndex]:=TP;
// Point to TP next propinfo record. // Point to TP next propinfo record.
// Located at Name[Length(Name)+1] ! // Located at Name[Length(Name)+1] !
TP:=aligntoptr(PPropInfo(pointer(@TP^.Name)+PByte(@TP^.Name)^+1)); TP:=aligntoptr(PPropInfo(pointer(@TP^.Name)+PByte(@TP^.Name)^+1));
Dec(Count); Dec(Count);
end; end;
// recursive call for parent info. TypeInfo:=TD^.Parentinfo;
If TD^.Parentinfo<>Nil then until TypeInfo=nil;
GetPropInfos (TD^.ParentInfo,PropList);
end; end;
Procedure InsertProp (PL : PProplist;PI : PPropInfo; Count : longint); Procedure InsertProp (PL : PProplist;PI : PPropInfo; Count : longint);