[fpc-pascal] Common class type

[Howard Page-Clark]

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