How do you override delegated method implementation? - delphi

In Delphi 2007, I am using one class to implement one of the supported interfaces of second class. This is working. The Delphi help states:
By default, using the implements keyword delegates all interface
methods. However, you can use methods resolution clauses or declare
methods in your class that implement some of the interface methods to
override this default behavior.
However, when I declare a method in my second class that has the matching signature of one of the interface methods, it isn't getting called.
I wonder if this is because I'm accessing the class through another interface when I create it.
Below is a test program that demonstrates my problem:
program Project1;
{$APPTYPE CONSOLE}
type
IInterface1 = interface
['{15400E71-A39B-4503-BE58-B6D19409CF90}']
procedure AProc;
end;
IInterface2 = interface
['{1E41CDBF-3C80-4E3E-8F27-CB18718E8FA3}']
end;
TDelegate = class(TObject)
protected
procedure AProc;
end;
TMyClass = class(TInterfacedObject, IInterface1, IInterface2)
strict private
FDelegate: TDelegate;
property Delegate: TDelegate read FDelegate implements IInterface1;
public
constructor Create;
destructor Destroy; override;
procedure AProc;
end;
procedure TDelegate.AProc;
begin
writeln('TClassDelegate.AProc');
end;
constructor TMyClass.Create;
begin
inherited;
FDelegate := TDelegate.Create;
end;
destructor TMyClass.Destroy;
begin
FDelegate.Free;
inherited;
end;
procedure TMyClass.AProc;
begin
writeln('TMyClass.AProc');
end;
var
MyObj : IInterface2;
begin
MyObj := TMyClass.Create;
(MyObj as IInterface1).AProc;
end.
When I run this I get as output:
TClassDelegate.AProc
What I want is:
TMyClass.AProc
Any help appreciated.

seems you have to redeclare your method in this way:
TMyClass = class(TInterfacedObject, IInterface1, IInterface2)
strict private
....
procedure test();
public
....
procedure IInterface1.AProc = test;
end;
procedure TMyClass.test;
begin
writeln('TMyClass.AProc');
end;
so IInterface1.AProc for TMyClass is mapped to Test() (not to FDelegate.AProc)
and result is TMyClass.AProc

The documentation explicitly states that the behaviour you see is as designed:
If the delegate property is of a class type, that class and its ancestors are searched for methods implementing the specified interface before the enclosing class and its ancestors are searched.
I guess in the full example you have an interface with multiple methods and are wanting the majority specified by the delegate, and specific ones overridden by the implementing class. I can't see how to achieve that with just one class, but it can be done if you introduce a second class:
program Project1;
{$APPTYPE CONSOLE}
type
IInterface1 = interface
['{15400E71-A39B-4503-BE58-B6D19409CF90}']
procedure AProc;
procedure AnotherProc;
end;
TDelegate = class
protected
procedure AProc;
procedure AnotherProc;
end;
TMyClass = class(TInterfacedObject, IInterface1)
strict private
FDelegate: TDelegate;
property Delegate: TDelegate read FDelegate implements IInterface1;
public
constructor Create;
destructor Destroy; override;
procedure AProc;
end;
TMyOtherClass = class(TMyClass, IInterface1)
procedure IInterface1.AProc = AProc;
end;
procedure TDelegate.AProc;
begin
writeln('TDelegate.AProc');
end;
procedure TDelegate.AnotherProc;
begin
writeln('TDelegate.AnotherProc');
end;
constructor TMyClass.Create;
begin
inherited;
FDelegate := TDelegate.Create;
end;
destructor TMyClass.Destroy;
begin
FDelegate.Free;
inherited;
end;
procedure TMyClass.AProc;
begin
writeln('TMyClass.AProc');
end;
var
MyObj: IInterface1;
begin
MyObj := TMyOtherClass.Create;
MyObj.AProc;
MyObj.AnotherProc;
Readln;
end.
As #teran points out, if you are prepared to rename your method then there is an easier solution.

It might be due to the visibility of the property. Every time I use implements the properties are protected or public, same for all the examples I could find in the VCL (eg TAutoObjectEvent.
Attempt #2:
What happens if you remove the AProc() method from TMyClass? Does it then use the one on TDelegate?

The part of documentation you mentioned seems to be outdated. If you try to use method resolution for an interface which is used in an implements clause you will get compiler error E2264: Cannot have method resolutions for interface '%s'.
The solution shown in the link above - to simply give the procedure the same name as declared in the interface - doesn't seem to work, either, in Delphi XE (it compiles but the procedure is not called).

Related

Interface reference counting in Delphi Supports function

I have class THuman which implements interface ICanTalk.
But whenever I try to check if human can talk, Supports function destroys object instance, despite the reference in the code.
What did I misunderstood?
procedure TForm1.Button1Click(Sender: TObject);
var
Obj:TInterfacedObject;
begin
Obj:=THuman.Create('Great guy');
// if Supports(Obj, ICanTalk) then //Object destroyed here if uncommented
(Obj as ICanTalk).TalkTo(Memo1.Lines);
end;
Implementation
ICanTalk = interface
['{57E5EF90-EB11-421C-AAFB-18CD789C0956}']
procedure TalkTo(List:TStrings);
end;
THuman = class(TInterfacedObject, ICanTalk)
private
FName: string;
public
procedure TalkTo(List:TStrings);
property Name:string read FName;
constructor Create(const AName:string);
end;
constructor THuman.Create(const AName: string);
begin
FName:=AName;
end;
procedure THuman.TalkTo(List: TStrings);
begin
List.Add(Name+' says Hello World!');
end;
This is expected. When you read the documentation about the Supports function, you found this:
Warning
With the exception of the overload that checks whether a TClass implements an interface, all the other versions of Supports will extract an interface reference either from an object or from another interface reference, causing the reference count of the underlying object to be incremented, and then will release the interface upon exit (decrementing the reference count). For objects that have a reference count of zero, this will result in the object destruction.
var
Obj: TInterfacedObject;
begin
Obj := TInterfacedObject.Create;
if Supports(Obj, IInterface) then { ... at this point Obj will be freed }
end;
You wrote,
despite the reference in the code(in visible area)
No, there is no reference. You declared Obj as TInterfacedObject (a class instance variable -- not an interface variable), and so there is no reference counting.
If you instead use an interface-typed variable, it will use reference counting:
var
Obj: IInterface;
This behavior really annoyed me. Why did Embarcadero not declare the internal variable as [unsafe]. In the following example, the object is only released with FreeAndNil. Alternatively, you can use TInterfacedPersistent instead of TInterfacedObject. Then you always have to release the object yourself.
program Project3;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
type
ICanTalk = interface
['{57E5EF90-EB11-421C-AAFB-18CD789C0956}']
procedure TalkTo;
end;
THuman = class(TInterfacedObject, ICanTalk)
public
destructor Destroy; override;
private
FName: string;
public
procedure TalkTo;
end;
procedure THuman.TalkTo;
begin
end;
destructor THuman.Destroy;
begin
inherited;
end;
var
o : THuman;
[unsafe]
intf : IInterface;
begin
try
o := THuman.Create;
Supports(o, ICanTalk, intf);
Intf := nil; //Didn't call destructor cause of [unsafe]!
FreeAndNil(o); //Call destructor!
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.

Generic Tlist<IMyInterface> in delphi

I have a TList of an interface
IImage = interface
// another methods...
procedure Draw;
end;
that draw different stuff in a Canvas.
and a parent class
TCustomImage = class(TInterfacedObject, IImage)
procedure Draw; virtual; abstract;
end;
and a couple of child classes
TSomeShape = class(TCustomImage, IImage)
procedure Draw(aCanvas:TCanvas); reintroduce; overload;
end;
TSomeAnotherShape = class(TCustomImage, IImage)
procedure Draw(aCanvas:TCanvas); reintroduce; overload;
end;
I would like to code as below:
var
list : TList<IImage>;
shape : IImage;
begin
try
list := TList<IImage>.Create;
list.Add(TSomeShape.Create(atSomePosition));
list.Add(TSomeAnotherShape.Create(atSomePosition));
// or better :)
for shape in list do
shape.Draw(Canvas); // TSomeShape and TSomeAnotherShape respectively.
finally
FreeAndNil(list);
end;
end;
UPD
I want to use the list.Items[I].draw() with the correct classes (TSomeShape or TSomeAnotherShape). But now, I see that it is impossible with this IImage interface. I had a method Draw(Canvas:TCanvas) in the IImage but thought that it is acceptably to reintroduce method in classes.
Thanks, I`ll work on my code.
:)
The problem is that your interface is defined incorrectly. Your concrete classes implement methods with this signature:
procedure Draw(Canvas: TCanvas);
But your interface defines a method with this signature:
procedure Draw;
You do need your interface and the concrete implementations to match. You'll want code like this:
type
IImage = interface
procedure Draw(Canvas: TCanvas);
end;
TCustomImage = class(TInterfacedObject, IImage)
procedure Draw(Canvas: TCanvas); virtual; abstract;
end;
TSomeShape = class(TCustomImage)
procedure Draw(Canvas: TCanvas); override;
end;
TSomeOtherShape = class(TCustomImage)
procedure Draw(Canvas: TCanvas); override;
end;
Now everything matches and your code should compile fine, and maybe even do what you want it to.
As an aside, your try is in the wrong place. You must place it after you instantiate the object. Write
obj := TSomeClass.Create;
try
// use obj
finally
obj.Free;
end;
As you have it in your code, an exception in the constructor will lead to the finally block running and attempting to call free on an uninitialized reference.

Can it make sense to call one overloaded constructor from another?

If I have two overloaded constructors, one without and one with parameters:
constructor Create; overload;
constructor Create(Param: TObject); overload;
If I want the code in the first one to run, does it make sense to call it within the second one? And inherited to call the parent constructor first as well?
constructor TMyType.Create(Param: TObject);
begin
inherited Create;
Create;
FParam := Param;
end;
Thanks!
If I want the code in the first one to run, does it make sense to call it within the second one And inherited to call the parent constructor first as well?
No. Because your 1st constructor should call inherited one itself, so in the end the inherited constructor would get called twice, which it most probably does not expect.
Otherwise, if your parameterless TMyType.Create() does not call inherited one, then it is hardly a proper constructor and should be just removed.
So the correct approach would be like that:
constructor TMyType.Create(Param: TObject); overload;
begin
Create();
FParam := Param;
end;
constructor TMyType.Create(); overload;
begin
inherited Create(); // for both constructors
...some common code
end;
However in Delphi there is yet another possibility.
constructor Create; overload;
constructor Create(Param: TObject); overload;
procedure AfterConstruction; override;
constructor TMyType.Create(Param: TObject);
begin
inherited Create();
FParam := Param;
end;
constructor TMyType.Create();
begin
inherited ;
... maybe some extra code
end;
procedure TMyType.AfterConstruction();
begin
inherited;
...some common code
end;
Note the difference though, when would "common code" be executed and when would do "FParam := Param;"
In the 1st way, the flow would be like
Create (Param)
..Create()
....Inherited Create()
....Common Code
..FParam := Param;
AfterConstruction (empty)
In the second the sequence would be different
Create(Param) or Create()
..Inherited Create()
..FParam := Param;
AfterConstruction
..Common Code
As you can see the order of those chunks being executed got reversed.
However maybe you don't need multiple constructors at all?
constructor TMyType.Create(const Param: TObject = nil);
begin
inherited;
... Some code
FParam := Param;
end;
Yes your code makes perfect sense and the constructor's calls do exactly what one should expect.
Delphi object model supports both constructors that call inherited constructors and constructors that do not call inherited ones.
If you are not sure try this:
program Project5;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
TMyBase = class
constructor Create;
end;
TMyType = class(TMyBase)
constructor Create; overload;
constructor Create(Param: TObject); overload;
end;
constructor TMyBase.Create;
begin
Writeln('TMyBase.Create');
end;
constructor TMyType.Create;
begin
Writeln('TMyType.Create');
end;
constructor TMyType.Create(Param: TObject);
begin
inherited Create;
Create;
Writeln('TMyType.Create(Param)');
end;
begin
TMyType.Create(TObject.Create);
Readln;
end.

Delphi customised constructor in TComponent never runs

i am new to delphi and i am creating a component in delphi 6. but i can't get the constructor to run:
unit MyComms1;
...
type
TMyComms = class(TComponent)
public
constructor MyConstructor;
end;
implementation
constructor TMyComms.MyConstructor;
begin
inherited;
ShowMessage('got here');
end;
it doesn't matter what the constructor is called, but this code doesn't run the constructor at all.
edit
by request, here is how the TMyComms class is initialized (this code is in a different file called TestComms.pas):
unit TestComms;
interface
uses MyComms1, ...
type
TForm1 = class(TForm)
MyCommsHandle = TMyComms;
...
procedure BtnClick(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
procedure TForm1.BtnClick(Sender: TObject);
begin
MyCommsHandle.AnotherMyCommsProcedure;
end;
edit 2
reading some of the answers it looks like constructors must be manually called in delphi. is this correct? if so then this is certainly my main error - i am used to php where the __construct function is automatically called whenever a class is assigned to a handle.
Most likely you are not calling TMyComms.MyConstructor to test your unusual called and used constructor. The way marked with // ** would be th most usual.
type
TMyComms = class(TComponent)
public
constructor MyConstructor;
// the usual override;
// constructor Create(Owner:TComponent);override; // **
constructor Create(AOwner:TComponent);overload; override;
constructor Create(AOwner:TComponent;AnOtherParameter:Integer);overload;
end;
constructor TMyComms.Create(AOwner: TComponent);
begin
inherited ;
ShowMessage('got here Create');
end;
constructor TMyComms.Create(AOwner: TComponent; AnOtherParameter: Integer);
begin
inherited Create(AOwner);
ShowMessage(Format('got here Create with new parametere %d',[AnOtherParameter]));
end;
constructor TMyComms.MyConstructor;
begin
inherited Create(nil);
ShowMessage('got here MyConstructor');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TMyComms.MyConstructor.Free;
TMyComms.Create(self).Free;
TMyComms.Create(self,1234).Free;
end;
Your code does not follow the Delphi naming guidelines - the constructor should be named Create.
Since you didn't posted the code actually calling the ctor, I guess, that you may not have called it at all. Try to add a button to your form, doubleclick it and add the following code:
procedure TForm1.Button1Click(Sender : TObject)
var comms : TMyComms;
begin
comms := TMyComms.MyConstructor;
comms.Free;
end;
By the way, if you derive from TComponent, you should override constructor with a parameter - otherwise inherited methods may not work properly.
interface
type TMyComms = class(TComponent)
private
protected
public
constructor Create(AOwner : TComponent); override;
end;
implementation
constructor TMyComms.Create(AOwner : TComponent)
begin
inherited Create(AOwner);
// Your stuff
end;
// Somewhere in code
var comms : TMyComms;
begin
comms := TMyComms.Create(nil);
end;
Your custom constructor is not called because you did not call it.
MyComm := TMyComms.MyConstructor;
But you also have an error in your code. Because there is no derived constructor you can inherite with simple inherited.
type
TMyComms = class(TComponent)
public
constructor MyConstructor;
end;
implementation
constructor TMyComms.MyConstructor;
begin
inherited Create( nil ); // !
ShowMessage('got here');
end;
You can use the simple inherited if your custom constructor use the same name and parameters from an existing constructor.
type
TMyComms = class(TComponent)
public
constructor Create( AOwner : TComponent ); override;
end;
implementation
constructor TMyComms.Create( AOwner : TComponent );
begin
inherited; // <- everything is fine
ShowMessage('got here');
end;

How can I create an Delphi object from a class reference and ensure constructor execution?

How can I create an instance of an object using a class reference, and
ensure that the constructor is executed?
In this code example, the constructor of TMyClass will not be called:
type
TMyClass = class(TObject)
MyStrings: TStrings;
constructor Create; virtual;
end;
constructor TMyClass.Create;
begin
MyStrings := TStringList.Create;
end;
procedure Test;
var
Clazz: TClass;
Instance: TObject;
begin
Clazz := TMyClass;
Instance := Clazz.Create;
end;
Use this:
type
TMyClass = class(TObject)
MyStrings: TStrings;
constructor Create; virtual;
end;
TMyClassClass = class of TMyClass; // <- add this definition
constructor TMyClass.Create;
begin
MyStrings := TStringList.Create;
end;
procedure Test;
var
Clazz: TMyClassClass; // <- change TClass to TMyClassClass
Instance: TObject;
begin
Clazz := TMyClass; // <- you can use TMyClass or any of its child classes.
Instance := Clazz.Create; // <- virtual constructor will be used
end;
Alternatively, you can use a type-casts to TMyClass (instead of "class of TMyClass").
Alexander's solution is a fine one but does not suffice in certain situations. Suppose you wish to set up a TClassFactory class where TClass references can be stored during runtime and an arbitrary number of instances retrieved later on.
Such a class factory would never know anything about the actual types of the classes it holds and thus cannot cast them into their according meta classes. To invoke the correct constructors in such cases, the following approach will work.
First, we need a simple demo class (don't mind the public fields, it's just for demonstration purposes).
interface
uses
RTTI;
type
THuman = class(TObject)
public
Name: string;
Age: Integer;
constructor Create(); virtual;
end;
implementation
constructor THuman.Create();
begin
Name:= 'John Doe';
Age:= -1;
end;
Now we instantiate an object of type THuman purely by RTTI and with the correct constructor call.
procedure CreateInstance();
var
someclass: TClass;
c: TRttiContext;
t: TRttiType;
v: TValue;
human1, human2, human3: THuman;
begin
someclass:= THuman;
// Invoke RTTI
c:= TRttiContext.Create;
t:= c.GetType(someclass);
// Variant 1a - instantiates a THuman object but calls constructor of TObject
human1:= t.AsInstance.MetaclassType.Create;
// Variant 1b - same result as 1a
human2:= THuman(someclass.Create);
// Variant 2 - works fine
v:= t.GetMethod('Create').Invoke(t.AsInstance.MetaclassType,[]);
human3:= THuman(v.AsObject);
// free RttiContext record (see text below) and the rest
c.Free;
human1.Destroy;
human2.Destroy;
human3.Destroy;
end;
You will find that the objects "human1" and "human2" have been initialized to zero, i.e., Name='' and Age=0, which is not what we want. The object human3 instead holds the default values provided in the constructor of THuman.
Note, however, that this method requires your classes to have constructor methods with not parameters. All the above was not conceived by me but explained brillantly and in much more detail (e.g., the c.Free part) in Rob Love's Tech Corner.
Please check if overriding AfterConstruction is an option.
Your code slightly modified:
type
TMyObject = class(TObject)
MyStrings: TStrings;
constructor Create; virtual;
end;
TMyClass = class of TMyObject;
constructor TMyObject.Create;
begin
inherited Create;
MyStrings := TStringList.Create;
end;
procedure Test;
var
C: TMyClass;
Instance: TObject;
begin
C := TMyObject;
Instance := C.Create;
end;
You can create an abstract method in base class, and call it in the constructor, and override in child classes to be executed when created from class reference.

Resources