Extend delphi class hierarchy

Question

I'm wondering how to expand the class hierarchy with additional features, following these details: 1) I can’t touch the original hierarchy 2) I need to develop new functions in another block

Take, for example, the following class hierarchy in the uClasses.pas element:

TBaseClass = class ID : Integer; Name : String; end; TDerivedClass = class(TBaseClass) Age : Integer Address : String end; 

I want to bind other functions to classes, for example, save myself in the text (this is just an example). Therefore, I introduced the following uClasses_Text.pas block:

 uses uClasses; Itextable = interface function SaveToText: String; end; TBaseClass_Text = class(TBaseClass, Itextable) function SaveToText: String; end; TDerivedClass_Text = class(TDerivedClass, ITextable) function SaveToText: String; end; function TBaseClass_Text.SaveToText: String; begin result := Self.ID + ' ' + Self.Name; end; function TDerivedClass_Text.SaveToText: String; begin // SaveToText on derived class must call SaveToText from the "BaseClass" and then append its additional fields result := ???? // Call to TBaseClass_Text.SaveToText. Or better, ITextable(Self.ParentClass).SaveToText; result := result + Self.Age + ' ' + Self.Address; end; 

How can I refer to the "base" implementation of SaveToText from TDerivedClass_Text.SaveToText? Maybe with the interface in some way?

Or is there a better and cleaner approach to this?

Thanks,

Answer 1

As David noted, you cannot reference a method in your base class that does not exist.

With the help of class helpers, you can solve your question differently. The first helper of the TBaseClassHelper class adds the SaveToText function, as well as the second class TDerivedClassHelper . Take a look at the implementation of this second SaveToText function. It calls inherited SaveToText .

Update 2

OP wanted to split units for different SaveTo implementations. Using the comments of David and Arioch, it turns out that class helpers can inherit from other class helpers. Here is a complete example:

 unit uClasses; type TBaseClass = class ID: Integer; Name: String; end; TDerivedClass = class(TBaseClass) Age: Integer; Address: String; end; 

---

 unit uClasses_Text; uses uClasses,uClasses_SaveToText,uClasses_SaveToIni,uClasses_SaveToDB; type ITextable = interface function SaveToText: string; function SaveToIni: string; function SaveToDB: string; end; // Adding reference counting through an interface, since multiple inheritance // is not possible (TInterfacedObject and TBaseClass) TBaseClass_Text = class(TBaseClass, IInterface, ITextable) strict private  FRefCount: Integer; protected  function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;  function _AddRef: Integer; stdcall;  function _Release: Integer; stdcall; end; TDerivedClass_Text = class(TDerivedClass, IInterface, ITextable) strict private  FRefCount: Integer; protected  function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;  function _AddRef: Integer; stdcall;  function _Release: Integer; stdcall; end; implementation uses Windows; function TBaseClass_Text.QueryInterface(const IID: TGUID; out Obj): HResult; begin if GetInterface(IID, Obj) then  Result := 0 else  Result := E_NOINTERFACE; end; function TBaseClass_Text._AddRef: Integer; begin Result := InterlockedIncrement(FRefCount); end; function TBaseClass_Text._Release: Integer; begin Result := InterlockedDecrement(FRefCount); if Result = 0 then  Destroy; end; function TDerivedClass_Text.QueryInterface(const IID: TGUID; out Obj): HResult; begin if GetInterface(IID, Obj) then  Result := 0 else  Result := E_NOINTERFACE; end; function TDerivedClass_Text._AddRef: Integer; begin Result := InterlockedIncrement(FRefCount); end; function TDerivedClass_Text._Release: Integer; begin Result := InterlockedDecrement(FRefCount); if Result = 0 then  Destroy; end; 

---

 unit uClasses_SaveToText; interface uses uClasses; type TBaseClassHelper = class helper for TBaseClass function SaveToText: string; end; TDerivedClassHelper = class helper for TDerivedClass function SaveToText: string; end; implementation function TBaseClassHelper.SaveToText: string; begin Result := 'BaseClass Text info'; end; function TDerivedClassHelper.SaveToText: string; begin Result := inherited SaveToText; Result := Result + ' DerivedClass Text info'; end; 

---

 unit uClasses_SaveToIni; interface Uses uClasses,uClasses_SaveToText; type TBaseClassHelperIni = class helper(TBaseClassHelper) for TBaseClass function SaveToIni: string; end; TDerivedClassHelperIni = class helper(TDerivedClassHelper) for TDerivedClass function SaveToIni: string; end; implementation function TBaseClassHelperIni.SaveToIni: string; begin Result := 'BaseClass Ini info'; end; function TDerivedClassHelperIni.SaveToIni: string; begin Result := inherited SaveToIni; Result := Result + ' DerivedClass Ini info'; end; 

---

 unit uClasses_SaveToDB; interface Uses uClasses,uClasses_SaveToText,uClasses_SaveToIni; Type TBaseClassHelperDB = class helper(TBaseClassHelperIni) for TBaseClass function SaveToDB: string; end; TDerivedClassHelperDB = class helper(TDerivedClassHelperIni) for TDerivedClass function SaveToDB: string; end; implementation function TBaseClassHelperDB.SaveToDB: string; begin Result := 'BaseClass DB info'; end; function TDerivedClassHelperDB.SaveToDB: string; begin Result := inherited SaveToDB; Result := Result + 'DerivedClass DB info'; end; 

---

 program TestClasses; uses uClasses in 'uClasses.pas', uClasses_Text in 'uClasses_Text.pas', uClasses_SaveToText in 'uClasses_SaveToText.pas', uClasses_SaveToIni in 'uClasses_SaveToIni.pas', uClasses_SaveToDB in 'uClasses_SaveToDB.pas'; var Textable: ITextable; begin Textable := TDerivedClass_Text.Create; WriteLn(Textable.SaveToText); WriteLn(Textable.SaveToIni); WriteLn(Textable.SaveToDB); ReadLn; end. 

Update 1

After reading your comments about the need to implement several aspects of SaveToText , I propose a simple feedback solution:

 type ITextable = interface function SaveToText: String; end; TMyTextGenerator = class(TInterfacedObject,ITextable) private Fbc : TBaseClass; public constructor Create( bc : TBaseClass); function SaveToText: String; end; { TMyTextGenerator } constructor TMyTextGenerator.Create(bc: TBaseClass); begin Inherited Create; Fbc := bc; end; function TMyTextGenerator.SaveToText: String; begin Result := IntToStr(Fbc.ID) + ' ' + Fbc.Name; if Fbc is TDerivedClass then begin Result := Result + ' ' + IntToStr(TDerivedClass(Fbc).Age) + ' ' + TDerivedClass(Fbc).Address; end; end; 

Implement TSaveToIni, TSaveToDB, etc. with the same pattern in separate units.

Answer 2

Since Delphi does not support multiple class inheritance, you are pushing for such solutions:

 function BaseClassSaveToText(obj: TBaseClass): string; begin Result := IntToStr(obj.ID) + ' ' + obj.Name; end; function TBaseClass_Text.SaveToText: String; begin Result := BaseClassSaveToText(Self); end; function DerivedClassSaveToText(obj: TDerivedClass): string; begin Result := BaseClassSaveToText(obj) + IntToStr(obj.Age) + ' ' + obj.Address; end; function TDerivedClass_Text.SaveToText: String; begin Result := DerivedClassSaveToText(Self); end; 

In DerivedClassSaveToText you would like to use the inherited keyword, but you cannot, because these two classes do not have a common ancestor.

Update: @LU RD shows how to do all this with class helpers. Personally, I am a little allergic to class mates. And, of course, there may be other reasons why you do not want to use helpers. For example, if you are using an older version of Delphi, then they do not exist.

Answer 3

Honesty is overrated in accordance with ... (I do not remember the song). I think that many of us overestimate inheritance and often solve problems with inheritance too quickly and not with composition or delegation.

I really doubt the desire to add the SaveToFile method to each class that you want to save to a file.

In my opinion, classes should be unaware of responsibilities that are not the reason for their existence. Perseverance is one such responsibility, typing another. The print class must be responsible for printing. Of course, you don’t want the print class to be a network of hornets of if statements to deal with every perceived class you want to print. Thus, you define the base class of the printer and extend it using the PeoplePrinter, LocationPrinter and WhateverPrinter descendants. Each of them can deal with the entire hierarchy of classes.

If you are thinking about a decorator now, well, well noticed.

The idea is that you are not creating descendants for the existing hierarchy, but you are creating classes and possibly class hierarchies for specific responsibilities. If you want to save an instance of an existing class, instead of calling SomeClass.SaveToText , you must create an instance of TSaver and pass it an instance of the class to save.

A very naive implementation might look like this.

 type TSaver = class(TObject) procedure SaveToText; virtual; abstract; end; TBaseHierarchySaver = class(TSaver) private FBase: TBaseClass; public constructor Create(aBase: TBaseClass); procedure SaveToText; override; class procedure Save(aBase: TBaseClass); end; constructor TBaseHierarchySaver.Create(aBase: TBaseClass); begin FBase := aBase; end; class procedure TBaseHierarchySaver.Save(aBase: TBaseClass); var Me: TSaver; begin Me := TBaseHierarchySaver.Create(aBase); Me.SaveToText; end; procedure TBaseHierarchySaver.SaveToText; var Str: TStrings; begin Str := TStringList.Create; try Str.Add(Format('%s (%d)', [FBase.Name, FBase.ID])); if FBase.InheritsFrom(TDerivedClass) then begin Str.Add(Format('%d', [TDerivedClass(FBase).Age])); Str.Add(Format('%s', [TDerivedClass(FBase).Address])); end; finally Str.SaveToFile('SomeFileName'); Str.Free; end; end; 

I don’t really like it. It's fragile. We can do better.

There are many ways to make the above code more flexible and / or to provide polymorphic execution. For example, TSaver may have a dictionary of anonymous methods associated with TBaseClass classes. TSaver.SaveToText can then receive the TBaseClass argument and be implemented to execute each anonymous method for the class of the instance passed to it, if it inherits from the class associated with this anonymous method.

 type TBaseClassClass = class of TBaseClass; TAddInfoProc = reference to procedure(aBase: TBaseClass; aStr: TStrings); TSaver = class(TObject) class var FAddInfoClasses: TDictionary<TBaseClassClass, TAddInfoProc>; public class procedure RegisterAddInfoProc(aBase: TBaseClassClass; aAddInfo: TAddInfoProc); class procedure SaveToText(aBase: TBaseClass); end; TSaver.RegisterAddInfoProc(TBaseClass, procedure(aBase: TBaseClass; aStr: TStrings) begin aStr.Add(Format('%s (%d)', [aBase.Name, aBase.ID])); end ); TSaver.RegisterAddInfoProc(TDerivedClass, procedure(aBase: TBaseClass; aStr: TStrings) begin aStr.Add(Format('%d', [TDerivedClass(FBase).Age])); aStr.Add(Format('%s', [TDerivedClass(FBase).Address])); end ); 

This frees you from inheritance hierarchies, but if you want to perform polymorphic execution, it can be changed to a dictionary linking specific TBaseClass descendants to the corresponding AddInfo descendant hierarchy, where each AddInfo descendant adds its own information:

 type TAddInfo = class(TObject) public procedure AddInfo(aBase: TBaseClass; aStr: TStrings); virtual; end; TDerivedAddInfo = class(TAddInfo) public procedure AddInfo(aBase: TBaseClass; aStr: TStrings); override; end; procedure TAddInfo.AddInfo(aBase: TBaseClass; aStr: TStrings); begin aStr.Add(Format('%s (%d)', [aBase.Name, aBase.ID])); end; procedure TDerivedAddInfo.AddInfo(aBase: TBaseClass; aStr: TStrings); var Derived: TDerivedClass absolute aBase; begin inherited; if not aBase.InheritsFrom(TDerivedClass) then Exit; aStr.Add(Format('%d', [Derived.Age])); aStr.Add(Format('%s', [Derived.Address])); end; type TBaseClassClass = class of TBaseClass; TAddInfoClass = class of TAddInfo; TSaver = class(TObject) class var FAddInfoClasses: TDictionary<TBaseClassClass, TAddInfoClass>; public class procedure RegisterAddInfoClass(aBase: TBaseClassClass; aAddInfo: TAddInfoClass); class procedure SaveToText(aBase: TBaseClass); end; 

Which, by the way, is very similar to the helper class method proposed elsewhere, but without limiting the presence of only one class helper at any given time. Thus, you can have TSaver, TPrinter, TMailer and everything else that you would like to do with TBaseClass, which is not its main responsibility.

Oh, by the way, the above use of the absolute is one of the few use cases for the absolute that I can handle. This is a convenient short arm for hard casting, which becomes safe thanks to an early exit restriction, which in itself is also one of the few use cases for early exits that I can handle :-)