function IsInteresting(AEditor: TPropertyEditor; const AFilter: TTypeKinds;
const APropNameFilter: String): Boolean;
var
visited: TFPList;
UpperPropName: String;
// check set element names against AFilter
function IsPropInSet( const ATypeInfo: PTypeInfo ) : Boolean;
var
TypeInfo: PTypeInfo;
TypeData: PTypeData;
i: Integer;
begin
Result := False;
TypeInfo := ATypeInfo;
if (TypeInfo^.Kind <> tkSet) then exit;
TypeData := GetTypeData(TypeInfo);
// Get TypeInfo of set type.
TypeInfo := TypeData^.CompType;
TypeData := GetTypeData(TypeInfo);
for i:= TypeData^.MinValue to TypeData^.MaxValue do
begin
Result := ContainsTextUpper( GetEnumName(TypeInfo, i), UpperPropName );
if Result then
Break;
end;
end;
//check if class has property name
function IsPropInClass( const ATypeInfo: PTypeInfo ) : Boolean;
var
propInfo: PPropInfo;
propList: PPropList;
i, propCount: Integer;
quSubclass: TFPList;
icurClass: Integer = 0;
begin
Result := False;
quSubclass := TFPList.Create;
quSubclass.Add(ATypeInfo);
while icurClass < quSubclass.Count do
begin
propCount := GetPropList(quSubclass.Items[icurClass], propList);
for i := 0 to propCount - 1 do
begin
propInfo := propList^[i];
Result := ContainsTextUpper(propInfo^.Name, UpperPropName);
if Result then break;
//if encounter a Set check its elements name.
if (propInfo^.PropType^.Kind = tkSet) then
begin
Result := IsPropInSet(propInfo^.PropType);
if Result then break;
end;
//queue subclasses(only once) to check later.
if (propInfo^.PropType^.Kind = tkClass) then
if quSubclass.IndexOf(propInfo^.PropType) >= 0 then Continue
else quSubclass.Add(propInfo^.PropType);
end;
if Assigned(propList) then FreeMem(propList);
//no need to check subclasses if result is already true.
if Result then break;
inc(icurClass);
end;
quSubclass.Free;
end;
// Add AForceShow to display T****PropertyEditor when subproperties found.
// and name of class is not the same as filter
procedure Rec(A: TPropertyEditor; AForceShow: Boolean = False);
var
propList: PPropList;
i: Integer;
ti: PTypeInfo;
edClass: TPropertyEditorClass;
ed: TPropertyEditor;
obj: TPersistent;
PropCnt: LongInt;
begin
ti := A.GetPropInfo^.PropType;
//DebugLn('IsInteresting: ', ti^.Name);
Result := ti^.Kind <> tkClass;
if Result then
begin
if (UpperPropName = '') or AForceShow then
exit;
// Check if check Set has element.
if (ti^.Kind = tkSet) and (A.ClassType <> TSetElementPropertyEditor) then
begin
Result := ContainsTextUpper(A.GetName, UpperPropName)
or IsPropInSet(A.GetPropType);
exit;
end;
// Check single Props
Result := ContainsTextUpper(A.GetName, UpperPropName);
exit;
end;
// Subroperties can change if user selects another object =>
// we must show the property, even if it is not interesting currently.
Result := paVolatileSubProperties in A.GetAttributes;
if Result then exit;
if tkClass in AFilter then
begin
// We want classes => any non-trivial editor is immediately interesting.
Result := A.ClassType <> TClassPropertyEditor;
if Result then
begin
// if no SubProperties check against filter name
if (UpperPropName <> '') then
if (paSubProperties in A.GetAttributes) then
Result := ContainsTextUpper(A.GetName, UpperPropName)
or IsPropInClass(A.GetPropType)
else
Result := ContainsTextUpper(A.GetName, UpperPropName);
exit;
end;
end
else if A.GetAttributes * [paSubProperties, paVolatileSubProperties] = [] then
exit;
obj := TPersistent(A.GetObjectValue);
// At this stage, there is nothing interesting left in empty objects.
if obj = nil then exit;
// Class properties may directly or indirectly refer to the same class,
// so we must avoid infinite recursion.
if visited.IndexOf(ti) >= 0 then exit;
visited.Add(ti);
// actual published properties can be different since the instance can be inherited
// so update type info from the instance
ti := obj.ClassInfo;
PropCnt := GetPropList(ti, propList);
try
for i := 0 to PropCnt - 1 do begin
if not (propList^[i]^.PropType^.Kind in AFilter + [tkClass]) then continue;
edClass := GetEditorClass(propList^[i], obj);
if edClass = nil then continue;
ed := edClass.Create(AEditor.FPropertyHook, 1);
try
ed.SetPropEntry(0, obj, propList^[i]);
ed.Initialize;
// filter TClassPropertyEditor name recursively
Rec(ed, ContainsTextUpper(A.GetName, UpperPropName) );
finally
ed.Free;
end;
if Result then break;
end;
finally
FreeMem(propList);
end;
visited.Delete(visited.Count - 1);
end;
begin
visited := TFPList.Create;
try
UpperPropName := Uppercase(APropNameFilter);
//DebugLn('IsInteresting -> ', AEditor.GetPropInfo^.Name, ': ', AEditor.GetPropInfo^.PropType^.Name);
Rec(AEditor);
//DebugLn('IsInteresting <- ', BoolToStr(Result, true));
finally
visited.Free;
end;
end;