
Listing One
unit Programmer;
interface
uses Employee, EmployeeCaller;
type
   TProgrammerSuperClasses   =   set of ( EmployeeSuperClass );

   TProgrammer   =   class
      public
         constructor Create;
         destructor Destroy; override;
         procedure Work( Hours : integer ); virtual;
      protected
         constructor CreateWithSuperClass(
            SuperClass   :   TEmployeeCaller );
      private
         m_SuperClass         :   TEmployeeCaller;
         m_Destructed      :   TProgrammerSuperClasses;
         m_NotVirtual      :   TProgrammerSuperClasses;
   end;

implementation
const
   g_ProgrammerSalary   =   15;
   g_LinesPerHour       =   5; (* industry average... *)

constructor TProgrammer.Create;
begin
   (* we create the superclass ourself, and pass it to the
   constructor that makes the object reference the superclass *)
   CreateWithSuperClass(
      TProgrammerEmployee.Create( Self, g_ProgrammerSalary ) );
   (* keep note of that we've made the superclass ourselves and
   therefore, we'll have to destruct it ourselves too *)
   m_NotVirtual   :=   m_NotVirtual + [ EmployeeSuperClass ];
end;

constructor TProgrammer.CreateWithSuperClass;
begin
   (* we initialize the base class BEFORE we initialize ourself
   so that all our member functions can rely on the superclass
   to exist. *)
   m_SuperClass   :=   SuperClass;
   (* the set is initialized empty so that if none of the
   destructors in the superclasses are invoked, they will be
   called *)
   m_Destructed := [ ];
   (* here goes all the code that customizes the superclass for
   use in the subclass, in this case every programmer get a fixed
   salary. *)
end;

(* this destructor is capable of taking the entire object down.
all the superclasses will forward its destructors here. it can
safely be overridden (so that all destructors called through
superclasses will be calling the destructor of the new subclass)
as long as the new destructor calls this one to destruct the
superclasses properly *)
destructor TProgrammer.Destroy;
begin
   (* the superclasses need to be destroyed in opposite order of
   creation. however, we only want to destroy those superclasses
   that we have created ourselves and not the virtual superclasses
   that is managed by a subclass *)
   if ( EmployeeSuperClass in m_NotVirtual ) then
   begin
      (* we don't know if the object is destroyed through
      any of its superclasses and hence we don't know if any
      destructors are already called. therefore, we take down the
      superclasses through a regular method so that they can be
      destructed in proper order, and thereafter release the
      memory for the superclasses which it is needed *)
      m_SuperClass.InheritedDestroy;
      (* we need to release the memory of those superclasses that
      has not yet have their destructor called (those superclasses
      which has not marked themselves as destructed) *)
      if not ( EmployeeSuperClass in m_Destructed ) then
         m_SuperClass.FreeInstance;
   end;
end;

(* if any of the virtual methods from the base class wasn't
intended to be overridden, then the default implmentation can
just call the implementation of the superclass, and it will seem
as it was never overridden (until some derived class does it) *)
procedure TProgrammer.Work;
begin
   (* first let the superclass have a shot at it *)
   m_SuperClass.InheritedWork( Hours );
   (* do extra work *)
end;

end.

Listing Two
unit ProgrammerCaller;         
interface
uses Programmer;
type
   TProgrammerCaller   =   class( TProgrammer )
      public
         (* notice that the destructor is not declared as a
         destructor, but as a regular procedure. this is done
         because we want to be able to call the method that
         properly takes down the base class, without calling
         a destructor (which will free memory) *)
         procedure InheritedDestroy;
         (* we create an extra method for every virtual method
         there is in the base class, since somewhere down the
         class tree, someone may want to override it (and also
         call the ancestor) *)
         procedure InheritedWork( Hours : integer );
   end;

implementation

(* the implementation of these classes are straight-forward... *)
procedure TProgrammerCaller.InheritedDestroy;
begin
   inherited Destroy;
end;

procedure TProgrammerCaller.InheritedWork;
begin
   inherited Work( Hours );
end;

end.

Listing Three
unit Lead;
interface
uses Employee, EmployeeCaller, Programmer, ProgrammerCaller,
   Manager, ManagerCaller;
type
   (* TLeadSuperClasses is a set containing an enumeration of
   the superclasses. this works like a multi-dimensional boolean
   (the flag for the dimension is set if its corresponding value
   in the enumeration is in the set) *)
   TLeadSuperClasses   =   set of ( EmployeeSuperClass,
      ProgrammerSuperClass, ManagerSuperClass );

   TLead   =   class
      public
         constructor Create;
         destructor Destroy; override;
         procedure WorkAsEmployee( Hours : integer ); virtual;
         procedure WorkAsProgrammer( Hours : integer ); virtual;
         procedure WorkAsManager( Hours : integer ); virtual;
         function AsEmployee : TEmployee; virtual;
         function AsProgrammer : TProgrammer; virtual;
         function AsManager : TManager; virtual;
      private
         m_EmployeeSuperClass   :   TEmployeeCaller;
         m_ProgrammerSuperClass   :   TProgrammerCaller;
         m_ManagerSuperClass      :   TManagerCaller;
         m_Destructed      :   TLeadSuperClasses;
   end;

implementation
const
   g_LeadSalary   =   25;

type
   (* the purpose of the TLeadEmployee class is to have
   a proxy that can forward virtual methods from the TEmployee
   virtual superclass to the TLead subclass *)
   TLeadEmployee   =   class( TEmployeeCaller )
         (* since the memory of the superclass and the subclass
         is located apart, we need to maintain a reference to
         the subclass so we can forward virtual methods *)
         m_SubClass   :   TLead;
         (* we need a constructor for this class since we have
         to set up the link to the subclass. it takes a
         reference to the subclass followed by all the
         parameters that the superclass needs to be created *)
         constructor Create(
            BackPtr   :   TLead;
            Salary   :   real );
         (* we must override the destructor so that we can forward
         the call to the destructor in the subclass *)
         destructor Destroy; override;
         (* all the virtual methods must be overriden here so
         that they can be forwarded to the subclass *)
         procedure Work( Hours : integer ); override;
   end;

   TLeadProgrammer   =   class( TProgrammerCaller )
         m_SubClass   :   TLead;
         (* we need a constructor for this class since we have
         to set up the link to the subclass. it takes a
         reference to the subclass followed by all the
         parameters that the superclass needs to be created *)
         constructor CreateWithSuperClass(
            BackPtr   :   TLead;
            SuperClass   :   TEmployeeCaller );
         destructor Destroy; override;
         procedure Work( Hours : integer ); override;
   end;

   TLeadManager      =   class( TManagerCaller )
         m_SubClass   :   TLead;
         constructor CreateWithSuperClass(
            BackPtr      :   TLead;
            SuperClass   :   TEmployeeCaller );
         destructor Destroy; override;
         procedure Work( Hours : integer ); override;
   end;

(* this constructor initialize all the members specific for this
class (i.e. the subclass reference) and construct the superclass
with the parameters given *)
constructor TLeadEmployee.Create;
begin
   m_SubClass := BackPtr;
   (* construct the superclass with the rest of the parameters
   given. we don't modify the parameters sent to the superclass
   at all - if any other behavior is wanted, this should be
   taken care of in the subclass, not here. the only purpose
   of this class is to provide a bridge between the superclass
   and the subclass *)
   inherited Create( Salary );
end;

(* this destructor is invoked when someone destructs the
TLead object through its TEmployee superclass (which is
a TLeadEmployee)
it shall NOT take down the superclass, since the superclasses
must be destructed in opposite order of creation, something only
the subclass can do since it knows about the other superclasses
*)
destructor TLeadEmployee.Destroy;
begin
   (* we have to tell the subclass that the destructor of this
   superclass already is called by putting the enumeration
   representing this class into the set of destructed superclasses
   *)
   m_SubClass.m_Destructed   :=
      m_SubClass.m_Destructed + [ EmployeeSuperClass ];
   (* the subclass shall coordinate the destruction of the
   entire object. hence the call to a destructor must be forwarded
   *)
   m_SubClass.Destroy;
end;

(* the virtual methods only forward the call to the corresponding
method in the subclass. this is also a good place to do name
resolution (in case methods in different superclasses have the
same name) *)
procedure TLeadEmployee.Work;
begin
   (* perform name resolution *)
   m_SubClass.WorkAsEmployee( Hours );
end;

(* this constructor initialize all the members specific for this
class (i.e. the subclass reference) and construct the superclass
with the parameters given *)
constructor TLeadProgrammer.CreateWithSuperClass;
begin
   m_SubClass := BackPtr;
   (* construct the superclass with the rest of the parameters
   given. we don't modify the parameters sent to the superclass
   at all - if any other behavior is wanted, this should be
   taken care of in the subclass, not here. the only purpose
   of this class is to provide a bridge between the superclass
   and the subclass *)
   inherited CreateWithSuperClass( SuperClass );
end;

destructor TLeadProgrammer.Destroy;
begin
   m_SubClass.m_Destructed   :=
      m_SubClass.m_Destructed + [ ProgrammerSuperClass ];
   m_SubClass.Destroy;
end;

procedure TLeadProgrammer.Work;
begin
   m_SubClass.WorkAsProgrammer( Hours );
end;

constructor TLeadManager.CreateWithSuperClass;
begin
   m_SubClass := BackPtr;
   inherited CreateWithSuperClass( SuperClass );
end;

destructor TLeadManager.Destroy;
begin
   m_SubClass.m_Destructed   :=
      m_SubClass.m_Destructed + [ ManagerSuperClass ];
   m_SubClass.Destroy;
end;

procedure TLeadManager.Work;
begin
   m_SubClass.WorkAsManager( Hours );
end;

constructor TLead.Create;
begin
   (* we initialize the base class BEFORE we initialize ourself
   so that all our member functions can rely on the superclass
   to exist. *)
   (* first, we create the virtual base superclass to be used in
   the other two superclasses. note that it is the TLead class
   that configures the virtual base superclass - the two other
   superclasses just accepts the already created object as their
   superclass *)
   m_EmployeeSuperClass   :=   TLeadEmployee.Create(
      Self, g_LeadSalary );
   m_ProgrammerSuperClass := TLeadProgrammer.CreateWithSuperClass(
      Self, m_EmployeeSuperClass );
   m_ManagerSuperClass      :=   TLeadManager.CreateWithSuperClass(
      Self, m_EmployeeSuperClass );
   (* the set is initialized empty so that if none of the
   destructors in the superclasses are invoked, they will be
   called *)
   m_Destructed := [ ];
end;

(* this destructor is capable of taking the entire object down.
all the superclasses will forward its destructors here. it can
safely be overridden( so that all destructors called through
superclasses will be calling the destructor of the new subclass)
as long as the new destructor calls this one to destruct the
superclasses properly *)
destructor TLead.Destroy;
begin
   (* the superclasses need to be destroyed in opposite order of
   creation. we don't know if the object is destroyed through
   any of its superclasses and hence we don't know if any
   destructors are already called. therefore, we take down the
   superclasses through a regular method so that they can be
   destructed in proper order, and thereafter release the memory
   for the superclasses which it is needed *)
   m_ManagerSuperClass.InheritedDestroy;
   m_ProgrammerSuperClass.InheritedDestroy;
   m_EmployeeSuperClass.InheritedDestroy;
   (* we need to release the memory of those superclasses that has
   not yet have their destructor called (those superclasses which
   has not marked themselves as destructed) *)
   if not ( ManagerSuperClass in m_Destructed ) then
      m_ManagerSuperClass.FreeInstance;
   if not ( ProgrammerSuperClass in m_Destructed ) then
      m_ProgrammerSuperClass.FreeInstance;
   if not ( EmployeeSuperClass in m_Destructed ) then
      m_EmployeeSuperClass.FreeInstance;
end;

(* if any of the virtual methods from the base class wasn't
intended to be overridden, then the default implmentation can
just call the implementation of the superclass, and it will seem
as it was never overridden (until some derived class does it) *)
procedure TLead.WorkAsEmployee;
begin
   (* a lead may have to split his time between being a programmer
   and a manager *)
   m_ProgrammerSuperClass.InheritedWork( Hours div 3 );
   m_ManagerSuperClass.InheritedWork( Hours - Hours div 3 );
end;

procedure TLead.WorkAsProgrammer;
begin
   m_ProgrammerSuperClass.InheritedWork( Hours );
end;

procedure TLead.WorkAsManager;
begin
   m_ManagerSuperClass.InheritedWork( Hours );
end;

(* return the actual superclass part of this object, so that we
can pass this object when a reference to one of the superclasses
is required. this way, we still have polymorphism *)
function TLead.AsEmployee;
begin
   Result   :=   m_EmployeeSuperClass;
end;

function TLead.AsProgrammer;
begin
   Result   :=   m_ProgrammerSuperClass;
end;

function TLead.AsManager;
begin
   Result   :=   m_ManagerSuperClass;
end;

end.

Kaufmann, Roland: Multiple inheritance in Delphi. 

Listing 1-7


