ideintf: added TOICustomPropertyGrid.ExtVisibility to optionally add extended rtti properties

components/ideintf/objectinspector.pp

@@ -22,6 +22,9 @@ unit ObjectInspector;
 
 {$Mode objfpc}{$H+}
 
+{$IF FPC_FULLVERSION>30300}
+  {$Define HasExtRtti}
+{$ENDIF}
 {off $DEFINE DoNotCatchOIExceptions}
 
 interface
@@ -270,6 +273,9 @@ type
   private
     FBackgroundColor: TColor;
     FColumn: TOICustomPropertyGridColumn;
+    {$IFDEF HasExtRtti}
+    FExtVisibility: TVisibilityClasses;
+    {$ENDIF}
     FGutterColor: TColor;
     FGutterEdgeColor: TColor;
     FHighlightColor: TColor;
@@ -351,6 +357,9 @@ type
     procedure SetColumn(const AValue: TOICustomPropertyGridColumn);
     procedure SetCurrentEditValue(const NewValue: string);
     procedure SetDrawHorzGridLines(const AValue: Boolean);
+    {$IFDEF HasExtRtti}
+    procedure SetExtVisibility(const AValue: TVisibilityClasses);
+    {$ENDIF}
     procedure SetFavorites(const AValue: TOIFavoriteProperties);
     procedure SetFilter(const AValue: TTypeKinds);
     procedure SetGutterColor(const AValue: TColor);
@@ -535,6 +544,9 @@ type
     property TopY: integer read FTopY write SetTopY default 0;
     property Favorites: TOIFavoriteProperties read FFavorites write SetFavorites;
     property Filter : TTypeKinds read FFilter write SetFilter;
+    {$IFDEF HasExtRtti}
+    property ExtVisibility: TVisibilityClasses read FExtVisibility write SetExtVisibility;
+    {$ENDIF}
     property HideClassNames: Boolean read FHideClassNames write FHideClassNames;
     property PropNameFilter : String read FPropNameFilter write FPropNameFilter;
   end;
@@ -1973,7 +1985,7 @@ begin
   // get properties
   if FSelection.Count>0 then begin
     GetPersistentProperties(FSelection, FFilter + [tkClass], FPropertyEditorHook,
-      @AddPropertyEditor, @EditorFilter);
+      @AddPropertyEditor, nil, @EditorFilter{$IFDEF HasExtRtti},ExtVisibility{$ENDIF});
   end;
   // sort
   FRows.Sort(@SortGridRows);
@@ -3397,6 +3409,15 @@ begin
   Invalidate;
 end;
 
+{$IFDEF HasExtRtti}
+procedure TOICustomPropertyGrid.SetExtVisibility(const AValue: TVisibilityClasses);
+begin
+  if FExtVisibility=AValue then Exit;
+  FExtVisibility:=AValue;
+  BuildPropertyList;
+end;
+{$ENDIF}
+
 procedure TOICustomPropertyGrid.SetFavorites(
   const AValue: TOIFavoriteProperties);
 begin
@@ -3408,12 +3429,10 @@ end;
 
 procedure TOICustomPropertyGrid.SetFilter(const AValue: TTypeKinds);
 begin
-  if (AValue<>FFilter) then
+  if AValue=FFilter then exit;
-  begin
   FFilter:=AValue;
   BuildPropertyList;
 end;
-end;
 
 procedure TOICustomPropertyGrid.SetGutterColor(const AValue: TColor);
 begin

components/ideintf/propedits.pp

@@ -19,6 +19,10 @@ unit PropEdits;
 // This unit contains a lot of base type conversions. Disable range checking.
 {$R-}
 
+{$IF FPC_FULLVERSION>30300}
+  {$Define HasExtRtti}
+{$ENDIF}
+
 interface
 
 uses
@@ -1279,7 +1283,8 @@ type
 procedure GetPersistentProperties(ASelection: TPersistentSelectionList;
   AFilter: TTypeKinds; AHook: TPropertyEditorHook; AProc: TGetPropEditProc;
   APropInfoFilterFunc: TPropInfoFilterFunc;
-  AEditorFilterFunc: TPropertyEditorFilterFunc);
+  AEditorFilterFunc: TPropertyEditorFilterFunc
+  {$IFDEF HasExtRtti};ExtVisibility: TVisibilityClasses = []{$ENDIF});
 
 procedure GetPersistentProperties(ASelection: TPersistentSelectionList;
   AFilter: TTypeKinds; AHook: TPropertyEditorHook; AProc: TGetPropEditProc;
@@ -1650,9 +1655,17 @@ type
     FList: PPropList;
     FCount: Integer;
     FSize: Integer;
+    {$IFDEF HasExtRtti}
+    FExtVisibility: TVisibilityClasses;
+    FListExt: PPropListEx;
+    function GetExt(Index: Integer): PPropInfoEx;
+    {$ENDIF}
     function Get(Index: Integer): PPropInfo;
   public
     constructor Create(Instance: TPersistent; Filter: TTypeKinds);
+    {$IFDEF HasExtRtti}
+    constructor Create(Instance: TPersistent; Filter: TTypeKinds; AddExtVisibility: TVisibilityClasses);
+    {$ENDIF}
     destructor Destroy; override;
     function Contains(P: PPropInfo): Boolean;
     procedure Delete(Index: Integer);
@@ -1660,6 +1673,10 @@ type
     procedure Sort;
     property Count: Integer read FCount;
     property Items[Index: Integer]: PPropInfo read Get; default;
+    {$IFDEF HasExtRtti}
+    property ExtVisibility: TVisibilityClasses read FExtVisibility;
+    property Ext[Index: Integer]: PPropInfoEx read GetExt;
+    {$ENDIF}
   end;
 
 //==============================================================================
@@ -2216,24 +2233,65 @@ type
 
 constructor TPropInfoList.Create(Instance:TPersistent; Filter:TTypeKinds);
 var
-  BigList: PPropList;
+  ListCapacity: integer;
-  TypeInfo: PTypeInfo;
+
+  procedure Add(PropInfo: PPropInfo{$IFDEF HasExtRtti}; Ext: PPropInfoEx{$ENDIF});
+  var
+    i: Integer;
+  begin
+    if PropInfo^.PropType^.Kind in Filter then begin
+      // check if name already exists in list
+      i:=FCount-1;
+      while (i>=0) and (CompareText(FList^[i]^.Name,PropInfo^.Name)<>0) do
+        dec(i);
+      if (i<0) then begin
+        // add property info
+        if FCount=ListCapacity then begin
+          if ListCapacity<16 then
+            ListCapacity:=16
+          else
+            ListCapacity:=ListCapacity*2;
+          ReAllocMem(FList,ListCapacity*SizeOf(Pointer));
+          {$IFDEF HasExtRtti}
+          ReAllocMem(FListExt,ListCapacity*SizeOf(Pointer));
+          {$ENDIF}
+        end;
+        FList^[FCount]:=PropInfo;
+        {$IFDEF HasExtRtti}
+        FListExt^[FCount]:=Ext;
+        {$ENDIF}
+        inc(FCount);
+      end;
+    end;
+  end;
+
+var
+  aTypeInfo: PTypeInfo;
   TypeData: PTypeData;
   PropInfo: PPropInfo;
   PropData: ^TPropData;
-  CurCount, i: integer;
+  {$IFDEF HasExtRtti}
+  PropList: PPropListEx;
+  PropInfoEx: PPropInfoEx;
+  {$ENDIF}
+  CurCount: integer;
   //CurParent: TClass;
 begin
-  TypeInfo:=Instance.ClassInfo;
+  aTypeInfo:=Instance.ClassInfo;
-  TypeData:=GetTypeData(TypeInfo);
-  GetMem(BigList,TypeData^.PropCount * SizeOf(Pointer));
 
-  // read all properties and remove doubles
+  // read all published properties and remove doubles
-  TypeInfo:=Instance.ClassInfo;
+  TypeData:=GetTypeData(aTypeInfo);
+  ListCapacity:=TypeData^.PropCount;
+  ReAllocMem(FList,ListCapacity * SizeOf(Pointer));
+  {$IFDEF HASEXTRTTI}
+  ReAllocMem(FListExt,ListCapacity * SizeOf(Pointer));
+  {$ENDIF}
+
+  aTypeInfo:=Instance.ClassInfo;
   FCount:=0;
   repeat
     // read all property infos of current class
-    TypeData:=GetTypeData(TypeInfo);
+    TypeData:=GetTypeData(aTypeInfo);
     // skip unitname
     PropData:=AlignToPtr(Pointer(@TypeData^.UnitName)+Length(TypeData^.UnitName)+1);
     // read property count
@@ -2242,7 +2300,7 @@ begin
 
     {writeln('TPropInfoList.Create D ',CurCount,' TypeData^.ClassType=',DbgS(TypeData^.ClassType));
     writeln('TPropInfoList.Create E ClassName="',TypeData^.ClassType.ClassName,'"',
-    ' TypeInfo=',DbgS(TypeInfo),
+    ' TypeInfo=',DbgS(aTypeInfo),
     ' TypeData^.ClassType.ClassInfo=',DbgS(TypeData^.ClassType.ClassInfo),
     ' TypeData^.ClassType.ClassParent=',DbgS(TypeData^.ClassType.ClassParent),
     ' TypeData^.ParentInfo=',DbgS(TypeData^.ParentInfo),
@@ -2256,34 +2314,43 @@ begin
 
     // read properties
     while CurCount>0 do begin
-      if PropInfo^.PropType^.Kind in Filter then begin
+      Add(PropInfo{$IFDEF HasExtRtti},nil{$ENDIF});
-        // check if name already exists in list
-        i:=FCount-1;
-        while (i>=0) and (CompareText(BigList^[i]^.Name,PropInfo^.Name)<>0) do
-          dec(i);
-        if (i<0) then begin
-          // add property info to BigList
-          BigList^[FCount]:=PropInfo;
-          inc(FCount);
-        end;
-      end;
       // point PropInfo to next propinfo record.
       // Located at Name[Length(Name)+1] !
       PropInfo:=PPropInfo(AlignToPtr(pointer(@PropInfo^.Name)+PByte(@PropInfo^.Name)^+1));
       dec(CurCount);
     end;
-    TypeInfo:=TypeData^.ParentInfo;
-    if TypeInfo=nil then break;
-  until false;
 
-  // create FList
+    {$IFDEF HasExtRtti}
-  FSize:=FCount * SizeOf(Pointer);
+    if FExtVisibility<>[] then begin
-  GetMem(FList,FSize);
+      CurCount:=GetPropListEx(aTypeInfo,PropList,FExtVisibility);
-  Move(BigList^,FList^,FSize);
+      try
-  FreeMem(BigList);
+        while CurCount>0 do begin
+          dec(CurCount);
+          PropInfoEx:=PropList^[CurCount];
+          Add(PropInfoEx^.Info,PropInfoEx);
+        end;
+      finally
+        Freemem(PropList);
+      end;
+    end;
+    {$ENDIF}
+
+    aTypeInfo:=TypeData^.ParentInfo;
+  until aTypeInfo=nil;
+
   Sort;
 end;
 
+{$IFDEF HasExtRtti}
+constructor TPropInfoList.Create(Instance: TPersistent; Filter: TTypeKinds;
+  AddExtVisibility: TVisibilityClasses);
+begin
+  FExtVisibility:=AddExtVisibility;
+  Create(Instance,Filter);
+end;
+{$ENDIF}
+
 destructor TPropInfoList.Destroy;
 begin
   if FList<>nil then FreeMem(FList,FSize);
@@ -2310,9 +2377,11 @@ end;
 procedure TPropInfoList.Delete(Index:Integer);
 begin
   Dec(FCount);
-  if Index < FCount then
+  if Index >= FCount then exit;
-    Move(FList^[Index+1],FList^[Index],
+  System.Move(FList^[Index+1],FList^[Index],(FCount-Index) * SizeOf(Pointer));
-      (FCount-Index) * SizeOf(Pointer));
+  {$IFDEF HasExtRtti}
+  System.Move(FListExt^[Index+1],FListExt^[Index],(FCount-Index) * SizeOf(Pointer));
+  {$ENDIF}
 end;
 
 function TPropInfoList.Get(Index:Integer):PPropInfo;
@@ -2320,42 +2389,56 @@ begin
   Result:=FList^[Index];
 end;
 
+{$IFDEF HasExtRtti}
+function TPropInfoList.GetExt(Index: Integer): PPropInfoEx;
+begin
+  Result:=FListExt^[Index];
+end;
+{$ENDIF}
+
 procedure TPropInfoList.Intersect(List:TPropInfoList);
 var
-  I:Integer;
+  i:Integer;
 begin
-  for I:=FCount-1 downto 0 do
+  for i:=FCount-1 downto 0 do
-    if not List.Contains(FList^[I]) then Delete(I);
+    if not List.Contains(FList^[i]) then Delete(i);
 end;
 
 procedure TPropInfoList.Sort;
+
   procedure QuickSort(L, R: Integer);
   var
-    I, J: Longint;
+    i, j: Longint;
-    P, Q: PPropInfo;
+    p: PPropInfo;
+    h: Pointer;
   begin
     repeat
-      I := L;
+      i := L;
-      J := R;
+      j := R;
-      P := FList^[(L + R) div 2];
+      p := FList^[(L + R) div 2];
       repeat
-        while CompareText(P^.Name, FList^[i]^.Name) > 0 do
+        while CompareText(p^.Name, FList^[i]^.Name) > 0 do
-          inc(I);
+          inc(i);
-        while CompareText(P^.Name, FList^[J]^.Name) < 0 do
+        while CompareText(p^.Name, FList^[j]^.Name) < 0 do
-          dec(J);
+          dec(j);
-        if I <= J then
+        if i <= j then
         begin
-          Q := FList^[I];
+          h := FList^[i];
-          Flist^[I] := FList^[J];
+          Flist^[i] := FList^[j];
-          FList^[J] := Q;
+          FList^[j] := h;
-          inc(I);
+          {$IFDEF HasExtRtti}
-          dec(J);
+          h := FListExt^[i];
+          FListExt^[i] := FListExt^[j];
+          FListExt^[j] := h;
+          {$ENDIF}
+          inc(i);
+          dec(j);
         end;
-      until I > J;
+      until i > j;
-      if L < J then
+      if L < j then
-        QuickSort(L, J);
+        QuickSort(L, j);
-      L := I;
+      L := i;
-    until I >= R;
+    until i >= R;
   end;
 begin
   if Count > 0 then
@@ -2532,7 +2615,8 @@ end;
 procedure GetPersistentProperties(ASelection: TPersistentSelectionList;
   AFilter: TTypeKinds; AHook: TPropertyEditorHook; AProc: TGetPropEditProc;
   APropInfoFilterFunc: TPropInfoFilterFunc;
-  AEditorFilterFunc: TPropertyEditorFilterFunc);
+  AEditorFilterFunc: TPropertyEditorFilterFunc
+  {$IFDEF HasExtRtti};ExtVisibility: TVisibilityClasses = []{$ENDIF});
 var
   I, J, SelCount: Integer;
   ClassTyp: TClass;
@@ -2554,12 +2638,13 @@ begin
   ClassTyp := Instance.ClassType;
   // Create a property candidate list of all properties that can be found in
   // every component in the list and in the Filter
-  Candidates := TPropInfoList.Create(Instance, AFilter);
+  Candidates := TPropInfoList.Create(Instance, AFilter{$IFDEF HasExtRtti},ExtVisibility{$ENDIF});
   try
     // check each property candidate
     for I := Candidates.Count - 1 downto 0 do
     begin
       PropInfo := Candidates[I];
+
       // check if property is readable
       if (PropInfo^.GetProc=nil)
       or ((not GShowReadOnlyProps) and (PropInfo^.PropType^.Kind <> tkClass)
@@ -2597,7 +2682,7 @@ begin
         PropLists.Count := SelCount;
         // Create a property info list for each component in the selection
         for I := 0 to SelCount - 1 do
-          PropLists[i] := TPropInfoList.Create(ASelection[I], AFilter);
+          PropLists[i] := TPropInfoList.Create(ASelection[I], AFilter{$IFDEF HasExtRtti},ExtVisibility{$ENDIF});
 
         // Eliminate each property in Candidates that is not in all property lists
         for I := 0 to SelCount - 1 do
@@ -3441,6 +3526,7 @@ begin
           Changed:=true;
           SetInterfaceProp(InstProp.Instance,InstProp.PropInfo,NewInterface);
         end;
+      else
       end;
     end;
   finally