[fpc-pascal] Common class type
Howard Page-Clark
hdpc at talktalk.net
Sat Mar 21 00:31:09 CET 2015
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
More information about the fpc-pascal
mailing list