I have an interface IComm declaring a routine SetMonitorLogLevel():
unit IFaceComm;
interface
type
TMonitorLogLevel = (mllOnlyImportant, mllAll);
IComm = Interface(IInterface)
procedure SetMonitorLogLevel(LogLevel: TMonitorLogLevel);
end;
end.
The interface is implemented by 2 Forms, which are similar to each other, frmBarComm and frmFooComm, that look like this:
TfrmBarComm = class(TForm, IFaceComm.IComm)
cboDebugLevel: TComboBox;
private
procedure SetMonitorLogLevel(LogLevel: IFaceComm.TMonitorLogLevel);
end;
Note that the 2 Forms have a lot of components in common, such as cboDebugLevel, but also can have components the other doesn't.
Both Forms implement IComm.SetMonitorLogLevel() in exactly the same way:
procedure TfrmBarComm.SetMonitorLogLevel(LogLevel: IFaceComm.TMonitorLogLevel);
begin
case LogLevel of
IFaceComm.TMonitorLogLevel.mllOnlyImportant:
Self.cboDebugLevel.ItemIndex := 0;
IFaceComm.TMonitorLogLevel.mllAll:
Self.cboDebugLevel.ItemIndex := 1;
end;
end;
How do I avoid violating the Don't Repeat Yourself (DRY) principle? I'm faced with this issue quite often, and it's particularly ugly when the copy-pasted routines are much bigger than the simple example I shown above.
The usual way to deal with this is to create another class which implements the interface. It might look like this:
type
TComboBoxCommImplementor = class(TInterfacedObject, IFaceComm.IComm)
private
FDebugLevel: TComboBox;
public
constructor Create(DebugLevel: TComboBox);
procedure SetMonitorLogLevel(LogLevel: TMonitorLogLevel);
end;
constructor TComboBoxCommImplementor.Create(DebugLevel: TComboBox);
begin
inherited Create;
FDebugLevel := DebugLevel;
end;
procedure TComboBoxCommImplementor.SetMonitorLogLevel(
LogLevel: IFaceComm.TMonitorLogLevel);
begin
case LogLevel of
IFaceComm.TMonitorLogLevel.mllOnlyImportant:
FDebugLevel.ItemIndex := 0;
IFaceComm.TMonitorLogLevel.mllAll:
FDebugLevel.ItemIndex := 1;
end;
end;
Then in your form implement the interface using delegation:
type
TfrmBarComm = class(TForm, IFaceComm.IComm)
cboDebugLevel: TComboBox;
private
FComm: IFaceComm.IComm;
property Comm: IFaceComm.IComm read FComm implements IFaceComm.IComm
public
constructor Create(AOwner: TComponent); override;
end;
constructor TfrmBarComm.Create(AOwner: TComponent);
begin
inherited;
FComm := TComboBoxCommImplementor.Create(cboDebugLevel);
end;
Create a frame that owns the components which are used on both forms.
The frame implements IComm. Both forms using the frame and both forms implement IComm.
The frame is accessible as property that delegates the interface implementation.
It looks like this:
type TfrmBarComm = class(TForm)
FFrameComm: TFrameComm;
public
property FrameComm: TFrameComm read FFrameComm implements IComm;
end;
Related
suppose i have this definitions:
TMyClass1 = class
end;
TMyClass2 = class
end;
IModel<T : class> = interface
['{E8262D6C-DCAB-46AC-822E-EC369CF734F8}']
function List() : TObjectList<T>;
end;
IPresenter<T : class> = interface
['{98FB7751-D75A-4C51-B55A-0E5FE68BE213}']
function Retrieve() : TObjectList<T>;
end;
IView<T : class> = interface
['{59384CD6-30D6-4BD8-AB3D-7FCF4D1A8618}']
procedure AssignPresenter(APresenter : IPresenter<T>);
end;
TModel<T : class> = class(TInterfacedObject, IModel<T>)
public
function List() : TObjectList<T>; virtual; abstract;
end;
TPresenter<T : class> = class(TInterfacedObject, IPresenter<T>)
strict private
{ Private declarations }
FModel : IModel<T>;
FView : IView<T>;
public
constructor Create(AView : IView<T>);
function Retrieve() : TObjectList<T>; virtual; abstract;
end;
TModelClass1 = class(TModel<TMyClass1>);
TPresenterClass1 = class(TPresenter<TMyClass1>);
TModelClass2 = class(TModel<TMyClass2>);
TPresenterClass2 = class(TPresenter<TMyClass2>);
and i have this form that implements some of the things i defined:
TForm1 = class(TForm, IView<TMyClass1>, IView<TMyClass2>)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
FPresenter1 : IPresenter<TMyClass1>;
FPresenter2 : IPresenter<TMyClass2>;
procedure AssignPresenter(APresenter : IPresenter<TMyClass1>); overload;
procedure AssignPresenter(APresenter : IPresenter<TMyClass2>); overload;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
TPresenterClass1.Create((Self as IView<TMyClass1>));
TPresenterClass2.Create((Self as IView<TMyClass2>));
end;
procedure TForm1.AssignPresenter(APresenter: IPresenter<TMyClass1>);
begin
Self.FPresenter1 := APresenter;
end;
procedure TForm1.AssignPresenter(APresenter: IPresenter<TMyClass2>);
begin
Self.FPresenter2 := APresenter;
end;
so the problem here is that delphi can't figure out what method to call, in this example, only the AssignPresenter(APresenter: IPresenter<TMyClass2>) is called in both cases, so probably im missing something here but i can't figure out atm.
thx in advance.
This is probably a duplicate but I cannot find it right now.
The problem is that the as operator for interfaces is not very compatible with generics. The as operator relies on the interface GUID. The interface is found by querying for an interface with matching GUID. And GUIDs don't fit at all well with generic instantiation.
Now let's look at your code.
TPresenterClass1.Create((Self as IView<TMyClass1>));
TPresenterClass2.Create((Self as IView<TMyClass2>));
The problem is that IView<TMyClass1> and IView<TMyClass2> have the same GUID:
type
IView<T : class> = interface
['{59384CD6-30D6-4BD8-AB3D-7FCF4D1A8618}']
procedure AssignPresenter(APresenter : IPresenter<T>);
end;
So both IView<TMyClass1> and IView<TMyClass2> share the same GUID, and when you query using as, the same interface will be returned irrespective of whether or not you asked for IView<TMyClass1> or IView<TMyClass2>.
So, the bottom line here is that as is rendered next to useless with generic interfaces as soon as an object implements ISomeInterface<T> twice with different T.
Embarcadero really should implement as in a manner that supports generics. I wouldn't hold your breath though.
You will need to find a different way to solve your problem.
No need to use as when you have the object implementing the interface - just write:
procedure TForm1.FormCreate(Sender: TObject);
begin
TPresenterClass1.Create(Self);
TPresenterClass2.Create(Self);
end;
The compiler figures this out properly. When you are using as it does a Supports call which fails for the reason explained by David already.
As an addition to David Heffernan's answer.
One way you could work around the problem would be to give a unique GUID to all the generic declarations you use:
IViewMyclass1 = interface(IView<TMyClass1>)
['{1A0F941F-BAB1-4723-A6C1-27036DF5D344}']
end;
IViewMyclass2 = interface(IView<TMyClass2>)
['{0C61A23A-DC50-43B0-97C9-8B0013DDC193}']
end;
Redefine the view's declaration.
TForm4 = class(TForm, IViewMyclass1, IViewMyclass2)
procedure TForm1.FormCreate(Sender: TObject);
begin
TPresenterClass1.Create((Self as IViewMyclass1));
TPresenterClass2.Create((Self as IViewMyclass2));
end;
And then the right overload is called.
Disclaimers:
This is the result of On-The-Fly testing (XE4). Reliability is unknown.
I'm aware this isn't very practical.
It's probably not something that should be extensively used as it isn't obvious where the code would fail.
I'm doing a full rewrite of an old library, and I'm not sure how to handle this situation (for the sake of being understood, all hail the bike analogy):
I have the following classes:
TBike - the bike itself
TBikeWheel - one of the bike's wheel
TBikeWheelFront and TBikeWheelBack, both inherits from TBikeWheel and then implements the specific stuff they need on top of it
This is pretty straightforward, but now I decide to create multiple kind of bikes, each bikes having it's own kinds of wheel - they do the same stuff as a regular front/back wheels, plus the specific for that bike.
TBikeXYZ - inherits from TBike
TBikeWheelXYZ - inherits from TBikeWheel
And here is my problem: TBikeWheelFrontXYZ should inherit from TBikeWheelXYZ (to get the specific methods of an XYZ wheel), but it should also inherit from TBikeWheelFront (to get the specific methods of a front wheel).
My question here is, how can I implement that in a way that doesn't:
feel like a hack
force me to rewrite the same code several time
Delphi does not support Multiple Inheritance. But classes can support / implement multiple interfaces and you can delegate interface implementation, so you can kinda simulate multiple inheritence.
Use interfaces. Something like this (Off the top of my head, based on your description.....)
type
IBikeWheel = interface
...
end;
IXYZ = interface
...
end;
IFrontWheel = interface(IBikeWheel)
...
end;
TBike = class
...
end;
TBikeWheel = class(TObject, IBikeWheel);
TBikeWheelXYZ = class(TBikeWheel, IXYZ);
TBikeFrontWheelXYZ = class(TBikeWheelXYZ, IFrontWheel);
Then implement classes for the interfaces that do what the corresponding classes in your old (presumably C/C++) library does and instantiate them in the corresponding class's constructor.
Use polymorhism to implment each 'thing' as an object hierarchy in its own right and then add object properties to that object in turn. So, create a hierarchy of wheels, and a hierarchy of bikes. Then add wheels to bikes as fields in the ancestor bike object. See below.
TBikeWheel = class
TBikeWheelXYZ = class( TBikeWheel )
TBike = class
FFrontWheel : TBikeWheel;
property FrontWheel : TBikeWheel
read FrontWhell
TBikeABC = class( TBike)
constructor Create;
end;
constructor TBikeABC.Create;
begin
inherited;
FFrontWheel := TBikeWheel.Create;
end;
TBikeXYZ = class( TBike)
constructor Create;
end;
constructor TBikeXYZ.Create;
begin
inherited;
FFrontWheel := TBikeWheelXYZ.Create;
end;
A variation of Brian Frost's suggestion:
TBikeWheel = class
TBikeWheelXYZ = class( TBikeWheel )
TBike = class
FFrontWheel : TBikeWheel;
protected
function CreateWheel: TBikeWheel; virtual;
public
property FrontWheel : TBikeWheel
read FrontWheel
end;
TBikeABC = class( TBike)
protected
function CreateWheel: TBikeWheel; override;
end;
function TBikeABC.CreateWheel: TBikeWheel;
begin
result := TBikeWheel.Create;
end;
TBikeXYZ = class( TBike)
protected
function CreateWheel: TBikeWheel; override;
end;
function TBikeXYZ.CreateWheel: TBikeWheel;
begin
result := TBikeWheelXYZ.Create;
end;
Basically - you CAN'T. Delphi does not support multiple inheritance.
So left with that dilemma, the question is: could you possibly refactor that library in such a way that you can get away with using interface? Is the multiple inheritance mostly about functions and methods? If so - use interfaces. Delphi can support multiple interfaces on a class.
If the multi-inheritance is more about inheriting actual functionality in the classes, then you're probably looking at a bigger scale refactoring, I'm afraid. You'll need to find a way to break up those functional dependencies in such a way you can make it inherit from a single base class, possibly with some additional interfaces thrown in.
Sorry I can't provide an easy answer - that's just the reality of it.
Marc
You can try to extract an interface, say IFrontWheel, out of TBikeWheelFront, so that it is a subclass of TBikeWheel but implements IFrontWheel. Then TBikeWheelXYZ inherits from TBikeWheel and TBikeWheelFrontXYZ inherits from TBikeWheelXYZ and implements IFrontWheel.
Then you can define a class TFrontwheel and give it the same methods as the interface, but now you implement them. Then TBikeWheelFront and TBikeWheelXYZ get a private member of type TFrontwheel and the IFrontWheel implementations of them simply delegate to the private member methods.
This way you don't have double implementations.
Another alternative with newer versions of Delphi is to leverage generics in a compositional model. This is particularly useful in the case where the multiple base classes (TBarA and TBarB in this example) are not accessible for modification (ie: framework or library classes). For example (note, the necessary destructor in TFoo<T> is omitted here for brevity) :
program Project1;
uses SysUtils;
{$APPTYPE CONSOLE}
type
TFooAncestor = class
procedure HiThere; virtual; abstract;
end;
TBarA = class(TFooAncestor)
procedure HiThere; override;
end;
TBarB = class(TFooAncestor)
procedure HiThere; override;
end;
TFoo<T: TFooAncestor, constructor> = class
private
FFooAncestor: T;
public
constructor Create;
property SomeBar : T read FFooAncestor write FFooAncestor;
end;
procedure TBarA.HiThere;
begin
WriteLn('Hi from A');
end;
procedure TBarB.HiThere;
begin
WriteLn('Hi from B');
end;
constructor TFoo<T>.Create;
begin
inherited;
FFooAncestor := T.Create;
end;
var
FooA : TFoo<TBarA>;
FooB : TFoo<TBarB>;
begin
FooA := TFoo<TBarA>.Create;
FooB := TFoo<TBarB>.Create;
FooA.SomeBar.HiThere;
FooB.SomeBar.HiThere;
ReadLn;
end.
you can try this way, if you do not want to repeat the code several times and want a decoupled code.
type
TForm1 = class(TForm)
btnTest: TButton;
procedure btnTestClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TBike = class
end;
IBikeWheel = interface
procedure DoBikeWheel;
end;
TBikeWheel = class(TInterfacedObject, IBikeWheel)
public
procedure DoBikeWheel;
end;
IBikeWheelFront = interface
procedure DoBikeWheelFront;
end;
TBikeWheelFront = class(TInterfacedObject, IBikeWheelFront)
public
procedure DoBikeWheelFront;
end;
IBikeWheelBack = interface
end;
TBikeWheelBack = class(TInterfacedObject, IBikeWheelBack)
end;
TBikeWheelFrontXYZ = class(TInterfacedObject, IBikeWheel, IBikeWheelFront)
private
FIBikeWheel: IBikeWheel;
FBikeWheelFront: IBikeWheelFront;
public
constructor Create();
property BikeWheel: IBikeWheel read FIBikeWheel implements IBikeWheel;
property BikeWheelFront: IBikeWheelFront read FBikeWheelFront implements IBikeWheelFront;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{ TBikeWheel }
procedure TBikeWheel.DoBikeWheel;
begin
ShowMessage('TBikeWheel.DoBikeWheel');
end;
{ TBikeWheelFrontXYZ }
constructor TBikeWheelFrontXYZ.Create;
begin
inherited Create;
Self.FIBikeWheel := TBikeWheel.Create;
Self.FBikeWheelFront := TBikeWheelFront.Create;
end;
{ TBikeWheelFront }
procedure TBikeWheelFront.DoBikeWheelFront;
begin
ShowMessage('TBikeWheelFront.DoBikeWheelFront');
end;
procedure TForm1.btnTestClick(Sender: TObject);
var
bikeWhell: TBikeWheelFrontXYZ;
begin
bikeWhell := nil;
try
try
bikeWhell := TBikeWheelFrontXYZ.Create;
IBikeWheelFront(bikeWhell).DoBikeWheelFront;
IBikeWheel(bikeWhell).DoBikeWheel;
except
on E: Exception do
begin
raise;
end;
end;
finally
if Assigned(bikeWhell) then FreeAndNil(bikeWhell);
end;
end;
Sorry, Delphi does not support Multiple Inheritance.
I would like to suggest the following steps:
Inherit the TBikeWheelFrontXYZ class from either TBikeWheelXYZ or TBikeWheelFront (since in Delphi multiple inheritance is impossible as mentioned in the answers above).
Convert one of the parent classes TBikeWheelXYZ or TBikeWheelFront to class helper for the TBikeWheel class.
Add the class helper unit to the unit, where the TBikeWheelFrontXYZ class is declared.
I work with Delphi 2006 and I have a complex class named TMyClassTest that have many methods
Some of those methods create nonvisual components and assign event handlers of those components and run methods of those components.
Also I have two classes that implement the same interface like below:
TMyClass1 = class(Class1, Interface1)
... //procedures from the Interface1
procedure MyClass1Proc1;
end;
TMyClass2 = class(Class2, Interface1)
... //procedures from the Interface1
procedure MyClass2Proc1;
procedure MyClass2Proc2
end;
Now I need that TMyClass1 and TMyClass2 to 'inherit' the TMyClassTest, too.
Much more ... Interface1 must contain (beyond its methods) all the methods from the MyClassTest.
How can I avoid to implement (like copy/paste) on both clases (TMyClass1 and TMyClass2) all the procedures from TMyClassTest ?
I don't want to keep the same code on three separate places.
Based on Arioch's comments I created a solution like:
(see http://docwiki.embarcadero.com/RADStudio/XE3/en/Implementing_Interfaces#Implementing_Interfaces_by_Delegation_.28Win32_only.29)
type
IMyInterface = interface
procedure P1;
procedure P2;
end;
TMyImplClass = class
procedure P1;
procedure P2;
end;
TMyClass1 = class(Class1, IMyInterface)
FMyImplClass: TMyImplClass;
property MyImplClass: TMyImplClass read FMyImplClass implements IMyInterface;
procedure IMyInterface.P1 = MyP1;
procedure MyP1;
end;
TMyClass2 = class(TInterfacedObject, IMyInterface)
FMyImplClass: TMyImplClass;
property MyImplClass: TMyImplClass read FMyImplClass implements IMyInterface;
procedure P3;
procedure P4;
end;
procedure TMyImplClass.P1;
// ...
procedure TMyImplClass.P2;
// ...
procedure TMyClass1.MyP1;
// ...
procedure TMyClass2.P3;
// ...
procedure TMyClass2.P4;
// ...
var
MyClass: TMyClass1;
MyInterface: IMyInterface;
begin
MyClass := TMyClass1.Create;
MyClass.FMyImplClass := TMyImplClass.Create; //Error !!!! FMyImplClass is a read only property !!!
MyInterface := MyClass;
MyInterface.P1; // calls TMyClass1.MyP1;
MyInterface.P2; // calls TImplClass.P2;
end;
Because I have an error at MyClass.FMyImplClass := TMyImplClass.Create; I tried to create FMyImplClass declaring constructor from TMyClass1 and TMyClass2 but don't work ok.
Is there some other method to create FMyImplClass ?
Now I tried a solution that seem to work ok. Can there happen some hidden efects?
type
IMyInterface = interface
procedure P1;
procedure P2;
procedure CreateFMyImplClass;
end;
TMyImplClass = class
procedure P1;
procedure P2;
end;
TMyClass1 = class(Class1, IMyInterface)
FMyImplClass: TMyImplClass;
property MyImplClass: TMyImplClass read FMyImplClass implements IMyInterface;
procedure IMyInterface.P1 = MyP1;
procedure MyP1;
procedure CreateFMyImplClass;
end;
TMyClass2 = class(TInterfacedObject, IMyInterface)
FMyImplClass: TMyImplClass;
property MyImplClass: TMyImplClass read FMyImplClass implements IMyInterface;
procedure P3;
procedure P4;
procedure CreateFMyImplClass;
end;
procedure TMyImplClass.P1;
// ...
procedure TMyImplClass.P2;
// ...
procedure TMyClass1.MyP1;
// ...
procedure TMyClass1.CreateFMyImplClass;
begin
FMyImplClass := TMyImplClass.Create;
end;
procedure TMyClass2.P3;
// ...
procedure TMyClass2.P4;
// ...
procedure TMyClass2.CreateFMyImplClass;
begin
FMyImplClass := TMyImplClass.Create;
end;
var
MyInterface: IMyInterface;
begin
if WantRemote then
MyInterface := TMyClass1.Create
else
MyInterface := TMyClass2.Create;
MyInterface.CreateFMyImplClass; // create FMyImplClass ;
MyInterface.P2; // calls TImplClass.P2;
end;
Delphi does not have Scala-like traits or Python-like mixins, nor it support multiple inheritance a la C++.
If you cannot make Class1 and Class2 inherit from TMyClassTest, then perhaps you have to rely on interface delegation: make TMyClassX no more implementing Interface1 directly, but instead add them a field of TMyClassTest and delegate their Interface1 to this field.
I think you'd better
move those new common functions into some Interface0 type
make Interface1 inherited from Interface0
make some TMyClassesBaseCommonTrait class, implementing Interface0
make two subclasses TMyClass1InternalEngine(TMyClassesBaseCommonTrait) and TMyClass2InternalEngine(TMyClassesBaseCommonTrait) implementing (in different, TMyClassX-specific ways, the rest of Interface1(Interface0) API
have TMyClassX classes internal private field of TMyClass2InternalEngine type doign real implemntation
Google for "delphi interface delegation" shows this as top link: Delphi: How delegate interface implementation to child object?
I'm doing a full rewrite of an old library, and I'm not sure how to handle this situation (for the sake of being understood, all hail the bike analogy):
I have the following classes:
TBike - the bike itself
TBikeWheel - one of the bike's wheel
TBikeWheelFront and TBikeWheelBack, both inherits from TBikeWheel and then implements the specific stuff they need on top of it
This is pretty straightforward, but now I decide to create multiple kind of bikes, each bikes having it's own kinds of wheel - they do the same stuff as a regular front/back wheels, plus the specific for that bike.
TBikeXYZ - inherits from TBike
TBikeWheelXYZ - inherits from TBikeWheel
And here is my problem: TBikeWheelFrontXYZ should inherit from TBikeWheelXYZ (to get the specific methods of an XYZ wheel), but it should also inherit from TBikeWheelFront (to get the specific methods of a front wheel).
My question here is, how can I implement that in a way that doesn't:
feel like a hack
force me to rewrite the same code several time
Delphi does not support Multiple Inheritance. But classes can support / implement multiple interfaces and you can delegate interface implementation, so you can kinda simulate multiple inheritence.
Use interfaces. Something like this (Off the top of my head, based on your description.....)
type
IBikeWheel = interface
...
end;
IXYZ = interface
...
end;
IFrontWheel = interface(IBikeWheel)
...
end;
TBike = class
...
end;
TBikeWheel = class(TObject, IBikeWheel);
TBikeWheelXYZ = class(TBikeWheel, IXYZ);
TBikeFrontWheelXYZ = class(TBikeWheelXYZ, IFrontWheel);
Then implement classes for the interfaces that do what the corresponding classes in your old (presumably C/C++) library does and instantiate them in the corresponding class's constructor.
Use polymorhism to implment each 'thing' as an object hierarchy in its own right and then add object properties to that object in turn. So, create a hierarchy of wheels, and a hierarchy of bikes. Then add wheels to bikes as fields in the ancestor bike object. See below.
TBikeWheel = class
TBikeWheelXYZ = class( TBikeWheel )
TBike = class
FFrontWheel : TBikeWheel;
property FrontWheel : TBikeWheel
read FrontWhell
TBikeABC = class( TBike)
constructor Create;
end;
constructor TBikeABC.Create;
begin
inherited;
FFrontWheel := TBikeWheel.Create;
end;
TBikeXYZ = class( TBike)
constructor Create;
end;
constructor TBikeXYZ.Create;
begin
inherited;
FFrontWheel := TBikeWheelXYZ.Create;
end;
A variation of Brian Frost's suggestion:
TBikeWheel = class
TBikeWheelXYZ = class( TBikeWheel )
TBike = class
FFrontWheel : TBikeWheel;
protected
function CreateWheel: TBikeWheel; virtual;
public
property FrontWheel : TBikeWheel
read FrontWheel
end;
TBikeABC = class( TBike)
protected
function CreateWheel: TBikeWheel; override;
end;
function TBikeABC.CreateWheel: TBikeWheel;
begin
result := TBikeWheel.Create;
end;
TBikeXYZ = class( TBike)
protected
function CreateWheel: TBikeWheel; override;
end;
function TBikeXYZ.CreateWheel: TBikeWheel;
begin
result := TBikeWheelXYZ.Create;
end;
Basically - you CAN'T. Delphi does not support multiple inheritance.
So left with that dilemma, the question is: could you possibly refactor that library in such a way that you can get away with using interface? Is the multiple inheritance mostly about functions and methods? If so - use interfaces. Delphi can support multiple interfaces on a class.
If the multi-inheritance is more about inheriting actual functionality in the classes, then you're probably looking at a bigger scale refactoring, I'm afraid. You'll need to find a way to break up those functional dependencies in such a way you can make it inherit from a single base class, possibly with some additional interfaces thrown in.
Sorry I can't provide an easy answer - that's just the reality of it.
Marc
You can try to extract an interface, say IFrontWheel, out of TBikeWheelFront, so that it is a subclass of TBikeWheel but implements IFrontWheel. Then TBikeWheelXYZ inherits from TBikeWheel and TBikeWheelFrontXYZ inherits from TBikeWheelXYZ and implements IFrontWheel.
Then you can define a class TFrontwheel and give it the same methods as the interface, but now you implement them. Then TBikeWheelFront and TBikeWheelXYZ get a private member of type TFrontwheel and the IFrontWheel implementations of them simply delegate to the private member methods.
This way you don't have double implementations.
Another alternative with newer versions of Delphi is to leverage generics in a compositional model. This is particularly useful in the case where the multiple base classes (TBarA and TBarB in this example) are not accessible for modification (ie: framework or library classes). For example (note, the necessary destructor in TFoo<T> is omitted here for brevity) :
program Project1;
uses SysUtils;
{$APPTYPE CONSOLE}
type
TFooAncestor = class
procedure HiThere; virtual; abstract;
end;
TBarA = class(TFooAncestor)
procedure HiThere; override;
end;
TBarB = class(TFooAncestor)
procedure HiThere; override;
end;
TFoo<T: TFooAncestor, constructor> = class
private
FFooAncestor: T;
public
constructor Create;
property SomeBar : T read FFooAncestor write FFooAncestor;
end;
procedure TBarA.HiThere;
begin
WriteLn('Hi from A');
end;
procedure TBarB.HiThere;
begin
WriteLn('Hi from B');
end;
constructor TFoo<T>.Create;
begin
inherited;
FFooAncestor := T.Create;
end;
var
FooA : TFoo<TBarA>;
FooB : TFoo<TBarB>;
begin
FooA := TFoo<TBarA>.Create;
FooB := TFoo<TBarB>.Create;
FooA.SomeBar.HiThere;
FooB.SomeBar.HiThere;
ReadLn;
end.
you can try this way, if you do not want to repeat the code several times and want a decoupled code.
type
TForm1 = class(TForm)
btnTest: TButton;
procedure btnTestClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TBike = class
end;
IBikeWheel = interface
procedure DoBikeWheel;
end;
TBikeWheel = class(TInterfacedObject, IBikeWheel)
public
procedure DoBikeWheel;
end;
IBikeWheelFront = interface
procedure DoBikeWheelFront;
end;
TBikeWheelFront = class(TInterfacedObject, IBikeWheelFront)
public
procedure DoBikeWheelFront;
end;
IBikeWheelBack = interface
end;
TBikeWheelBack = class(TInterfacedObject, IBikeWheelBack)
end;
TBikeWheelFrontXYZ = class(TInterfacedObject, IBikeWheel, IBikeWheelFront)
private
FIBikeWheel: IBikeWheel;
FBikeWheelFront: IBikeWheelFront;
public
constructor Create();
property BikeWheel: IBikeWheel read FIBikeWheel implements IBikeWheel;
property BikeWheelFront: IBikeWheelFront read FBikeWheelFront implements IBikeWheelFront;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{ TBikeWheel }
procedure TBikeWheel.DoBikeWheel;
begin
ShowMessage('TBikeWheel.DoBikeWheel');
end;
{ TBikeWheelFrontXYZ }
constructor TBikeWheelFrontXYZ.Create;
begin
inherited Create;
Self.FIBikeWheel := TBikeWheel.Create;
Self.FBikeWheelFront := TBikeWheelFront.Create;
end;
{ TBikeWheelFront }
procedure TBikeWheelFront.DoBikeWheelFront;
begin
ShowMessage('TBikeWheelFront.DoBikeWheelFront');
end;
procedure TForm1.btnTestClick(Sender: TObject);
var
bikeWhell: TBikeWheelFrontXYZ;
begin
bikeWhell := nil;
try
try
bikeWhell := TBikeWheelFrontXYZ.Create;
IBikeWheelFront(bikeWhell).DoBikeWheelFront;
IBikeWheel(bikeWhell).DoBikeWheel;
except
on E: Exception do
begin
raise;
end;
end;
finally
if Assigned(bikeWhell) then FreeAndNil(bikeWhell);
end;
end;
Sorry, Delphi does not support Multiple Inheritance.
I would like to suggest the following steps:
Inherit the TBikeWheelFrontXYZ class from either TBikeWheelXYZ or TBikeWheelFront (since in Delphi multiple inheritance is impossible as mentioned in the answers above).
Convert one of the parent classes TBikeWheelXYZ or TBikeWheelFront to class helper for the TBikeWheel class.
Add the class helper unit to the unit, where the TBikeWheelFrontXYZ class is declared.
Is it possible to pass interface's method as parameters?
I'm trying something like this:
interface
type
TMoveProc = procedure of object;
// also tested with TMoveProc = procedure;
// procedure of interface is not working ;)
ISomeInterface = interface
procedure Pred;
procedure Next;
end;
TSomeObject = class(TObject)
public
procedure Move(MoveProc: TMoveProc);
end;
implementation
procedure TSomeObject.Move(MoveProc: TMoveProc);
begin
while True do
begin
// Some common code that works for both procedures
MoveProc;
// More code...
end;
end;
procedure Usage;
var
o: TSomeObject;
i: ISomeInterface;
begin
o := TSomeObject.Create;
i := GetSomeInterface;
o.Move(i.Next);
// somewhere else: o.Move(i.Prev);
// tested with o.Move(#i.Next), ##... with no luck
o.Free;
end;
But it is not working because:
E2010 Incompatible types: 'TMoveProc' and 'procedure, untyped pointer or untyped parameter'
Of course I can do private method for each call, but that is ugly. Is there any better way?
Delphi 2006
Edit:
I know that I can pass whole interface, but then I have to specify which function use. I don't want two exactly same procedures with one different call.
I can use second parameter, but that is ugly too.
type
SomeInterfaceMethod = (siPred, siNext)
procedure Move(SomeInt: ISomeInterface; Direction: SomeInterfaceMethod)
begin
case Direction of:
siPred: SomeInt.Pred;
siNext: SomeInt.Next
end;
end;
Thanks all for help and ideas. Clean solution (for my Delphi 2006) is Diego's Visitor. Now I'm using simple ("ugly") wrapper (my own, same solution by TOndrej and Aikislave).
But true answer is "there is no (direct) way to pass interface's methods as parameters without some kind of provider.
If you were using Delphi 2009, you could do this with an anonymous method:
TSomeObject = class(TObject)
public
procedure Move(MoveProc: TProc);
end;
procedure Usage;
var
o: TSomeObject;
i: ISomeInterface;
begin
o := TSomeObject.Create;
i := GetSomeInterface;
o.Move(procedure() begin i.Next end);
The problem with trying to pass a reference to just the interface method is that you are not passing a reference to the interface itself, so the interface cannot be reference counted. But anonymous methods are themselves reference counted, so the interface reference inside the anonymous method here can be reference counted as well. That is why this method works.
I don't know the exact reason why you need to do that, but, personally, I think it would be better to pass the whole "Mover" object instead of one of its methods. I used this approach in the past, it's called "Visitor" pattern.
tiOPF, an object persistence framework, uses it extensively and gives you a good example of how it works: The Visitor Pattern and the tiOPF.
It's relatively long, but it proved very useful to me, even when I didn't use tiOPF. Note step 3 in the document, titled "Step #3. Instead of passing a method pointer, we will pass an object".
DiGi, to answer your comment: If you use Visitor pattern, then you don't have an interface implementing multiple methods, but just one (Execute). Then you'd have a class for each action, like TPred, TNext, TSomething, and you pass an instance of such classes to the object to be processed. In such way, you don't have to know what to call, you just call "Visitor.Execute", and it will do the job.
Here you can find a basic example:
interface
type
TVisited = class;
TVisitor = class
procedure Execute(Visited: TVisited); virtual; abstract;
end;
TNext = class(TVisitor)
procedure Execute (Visited: TVisited); override;
end;
TPred = class(TVisitor)
procedure Execute (Visited: TVisited); override;
end;
TVisited = class(TPersistent)
public
procedure Iterate(pVisitor: TVisitor); virtual;
end;
implementation
procedure TVisited.Iterate(pVisitor: TVisitor);
begin
pVisitor.Execute(self);
end;
procedure TNext.Execute(Visited: TVisited);
begin
// Implement action "NEXT"
end;
procedure TPred.Execute(Visited: TVisited);
begin
// Implement action "PRED"
end;
procedure Usage;
var
Visited: TVisited;
Visitor: TVisitor;
begin
Visited := TVisited.Create;
Visitor := TNext.Create;
Visited.Iterate(Visitor);
Visited.Free;
end;
Although the wrapper class solution works, I think that's an overkill. It's too much code, and you have to manually manage the lifetime of the new object.
Perhaps a simpler solution would be to create methods in the interface that returns TMoveProc
ISomeInterface = interface
...
function GetPredMeth: TMoveProc;
function GetNextMeth: TMoveProc;
...
end;
The class that implements the interface can provide the procedure of object and it will be accessible through the interface.
TImplementation = class(TInterfaceObject, ISomeInterface)
procedure Pred;
procedure Next;
function GetPredMeth: TMoveProc;
function GetNextMeth: TMoveProc;
end;
...
function TImplementation.GetPredMeth: TMoveProc;
begin
Result := Self.Pred;
end;
function TImplementation.GetNextMeth: TMoveProc;
begin
Result := Self.Next;
end;
How about this:
type
TMoveProc = procedure(const SomeIntf: ISomeInterface);
TSomeObject = class
public
procedure Move(const SomeIntf: ISomeInterface; MoveProc: TMoveProc);
end;
procedure TSomeObject.Move(const SomeIntf: ISomeInterface; MoveProc: TMoveProc);
begin
MoveProc(SomeIntf);
end;
procedure MoveProcNext(const SomeIntf: ISomeInterface);
begin
SomeIntf.Next;
end;
procedure MoveProcPred(const SomeIntf: ISomeInterface);
begin
SomeIntf.Pred;
end;
procedure Usage;
var
SomeObj: TSomeObject;
SomeIntf: ISomeInterface;
begin
SomeIntf := GetSomeInterface;
SomeObj := TSomeObject.Create;
try
SomeObj.Move(SomeIntf, MoveProcNext);
SomeObj.Move(SomeIntf, MoveProcPred);
finally
SomeObj.Free;
end;
end;
Here is another solution that is working in Delphi 20006. It is similar to the idea of #Rafael, but using interfaces:
interface
type
ISomeInterface = interface
//...
end;
IMoveProc = interface
procedure Move;
end;
IMoveProcPred = interface(IMoveProc)
['{4A9A14DD-ED01-4903-B625-67C36692E158}']
end;
IMoveProcNext = interface(IMoveProc)
['{D9FDDFF9-E74E-4F33-9CB7-401C51E7FF1F}']
end;
TSomeObject = class(TObject)
public
procedure Move(MoveProc: IMoveProc);
end;
TImplementation = class(TInterfacedObject,
ISomeInterface, IMoveProcNext, IMoveProcPred)
procedure IMoveProcNext.Move = Next;
procedure IMoveProcPred.Move = Pred;
procedure Pred;
procedure Next;
end;
implementation
procedure TSomeObject.Move(MoveProc: IMoveProc);
begin
while True do
begin
// Some common code that works for both procedures
MoveProc.Move;
// More code...
end;
end;
procedure Usage;
var
o: TSomeObject;
i: ISomeInterface;
begin
o := TSomeObject.Create;
i := TImplementation.Create;
o.Move(i as IMoveProcPred);
// somewhere else: o.Move(i as IMoveProcNext);
o.Free;
end;
You can't. Because of the scoping of Interfaces it would be possible (perhaps?) for the Interface to be released before you called the .Next function. If you want to do this you should pass the whole interface to your method rather than just a method.
Edited...
Sorry, this next bit, specifically the "Of Interface" bit was meant in jest.
Also, and I could be wrong here, i.Next is not a method Of Object, as per your type def, it would be a method Of Interface!
Redefine your function
TSomeObject = class(TObject)
public
procedure Move(Const AMoveIntf: ISomeInterface);
end;
Procedure TSomeObject.Move(Const AMoveIntf : ISomeInterface);
Begin
....;
AMoveIntf.Next;
end;
O.Move(I);
Hope this helps.
You currently have TMoveProc defined as
TMoveProc = procedure of object;
Try taking out the "of object" which implies a hidden "this" pointer as first parameter.
TMoveProc = procedure;
That should allow a normal procedure to be called.