On 20/03/2015 07:25, Torsten Bonde Christiansen wrote:
Hi.
Is there method in fpc to find the highest common class-type of two
derived classes?
I do not know of such a routine, though there may well be one somewhere.
I would have said that the highest common class would always be TObject,
because a descendent class is usually spoken of as 'lower' rather than
'higher' than its ancestor.
I think the following does the job (perhaps rather inefficiently).
function LowestCommonClass(class1, class2: TClass): TClass;
var
sl: TStringList;
cp: TClass;
function FoundClassInList(aClass: TClass; out aCommonClass: TClass):
boolean;
var
i: integer;
s: string;
begin
Result:=False;
aCommonClass:=nil;
s:=aClass.ClassName;
for i:=0 to sl.Count-1 do
if SameText(sl[i], s) then begin
aCommonClass:=TClass(sl.Objects[i]);
Exit(True);
end;
end;
begin
Result:=nil;
sl:=TStringList.Create;
try
sl.AddObject(class1.ClassName, TObject(class1));
cp:=class1.ClassParent;
while (cp <> nil) do begin
sl.AddObject(cp.ClassName, TObject(cp));
cp:=cp.ClassParent;
end;
cp:=class2;
while (cp <> nil) do begin
if FoundClassInList(cp, Result) then
Exit;
cp:=cp.ClassParent;
end;
finally
sl.Free;
end;
end;
---
This email has been checked for viruses by Avast antivirus software.
http://www.avast.com
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
