Delphi - Down casting object does not call base method - delphi

I have a base object type : TBServiceBookings and then I've derived another object type from that : TBServiceQuotes
So when my form is created I decide which object to use. In this instance I've created the derived object.
if fScreenType = ST_NewAppointment then
fBookingObject := TBServiceBookings.CreateServiceBookings(nil,botSingle)
else
fBookingObject := TBServiceQuotes.CreateServiceQuotes(nil,botSingle);
At some stage I want to call a method of the base class only. So I cast the derived object to the base type and call it's method, but it keeps on going to the derived method - which I don't want.
I've tried:
1) fBookingObject := TBServiceBookings(fBookingObject);
fBookingObject.SetupNewAppointmentScreen;
2)
TBServiceBookings(fBookingObject).SetupNewAppointmentScreen;
3)
(fBookingObject as TBServiceBookings).SetupNewAppointmentScreen;
What am I missing? Why does the derived method get called each time even though I've downcasted specifically to call the base method?
The only option I have left is to create a new variable of the base type and then carry on with that. But I already have a form variable which is my object, I just want to call a specific base class method.
Any help appreciated please!

Besides the question that lies behind your question "where do you need this unusual and somewhat suspicious construct for?", there are some possibilities to access an ancestor virtual method.
Really ugly: change the type of your component:
var
SaveType: TClass;
begin
SaveType := Self.ClassType;
PClass(Self)^ := TAncestor;
try
Self.AncestorMethod;
finally
PClass(Self)^ := SaveType
end;
end;
Cast the method instead of the class:
type
TInstanceMethod = procedure(Instance: TObject);
begin
TInstanceMethod(#TAncestor.AncestorMethod)(Self);
end;
Employ a class helper:
type
TAncestorHelper = class helper for TAncestor
procedure AncestorMethodViaHelper;
end;
procedure TAncestorHelper.AncestorMethodViaHelper;
begin
inherited AncestorMethod;
end;
begin
Self.AncestorMethodViaHelper;
end;
When in need, I myself always use the second solution. But that is only when dealing with ancestors I cannot change, e.g. the VCL. Within your own framework, you would never need these hacks because you can just redesign.

Well if the class is yours, you have full control, so just don't override the base method you want to call. Like :
fBaseObject.ThisMethodBase; { calls the original }
fDerivedObject.ThisMethod; { calls the new one }
Seems like the simplest way to do it. Also remember you can simply call the Inherited method from your overriden method. So if you want to get creative you can pass a boolean that indicates if you want the base functionality. Like :
type
TX1=class
function ThisMethod(whatever:Integer;callOldOne:Boolean=false):integer;virtual;
end;
TX2=class(TX1)
function ThisMethod(whatever:Integer;callOldOne:Boolean=false):integer;override;
end;
function TX1.ThisMethod(whatever:Integer;callOldOne:Boolean=false):integer;
begin
result:=1;
end;
function TX2.ThisMethod(whatever:Integer;callOldOne:Boolean=false):integer;
begin
if callOldOne then result:=inherited ThisMethod(whatever) else Result:=2;
end;
Object oriented programming is fun.

Related

Calling child class non-virtual method or setting child class property

I have a base class TThread which has child classes like TThreadSock and TThreadPool, which override the .Terminate() method. And childs of those childs (like TThreadSockDownload or TThreadPoolCollect) inherite those .Terminate() methods (or might even override them):
type
TThreadSock= class( TThread )
procedure Terminate; // Hides TThread.Terminate
end;
TThreadSockDownload= class( TThreadSock );
TThreadSockUpload= class( TThreadSock )
procedure Terminate; // Hides TThreadSock.Terminate
end;
TThreadPool= class( TThread )
procedure Terminate; // Hides TThread.Terminate
end;
TThreadPoolCollect= class( TThreadPool );
My problem is: I have a list which can contain everything, so the most common denominator is TThread. And from that base class I need to call the most "childish" .Terminate() method. Currently my approach is this:
var
oThread: TThread;
begin
oThread:= GetNextThread();
if oThread is TThreadSockDownload then TThreadSockDownload(oThread).Terminate() else
if oThread is TThreadSockUpload then TThreadSockUpload(oThread).Terminate() else
if oThread is TThreadPoolCollect then TThreadPoolCollect(oThread).Terminate() else ...
...and you get an idea where this leads to. Not much to speak of that I have to use this code elsewhere as well. If I'd call oThread.Terminate() then the code of the base class is executed, which is not what I want. And defining the method as virtual also won't fully work, as every child level could be the "last" one. Or not.
My ultimate goal is to generalize this as much as possible, so I don't need to ask for each class as a candidate. Maybe I'm missing something fundamental here, like GetRealClass( oThread ).Call( 'Terminate' ); and GetRealClass( oThread ).Set( 'Stop', TRUE ); would be a dream.
Am I at least able to generalize this code so I only need to write it once? Something like FindMethod on an object I also have tell its class type to?
The correct way to deal with this is to use a virtual method. This mechanism is designed to allow method dispatch based on the runtime type of an object. In other words, precisely your your laboured type checking code does.
But you are grappling with the fact that you want to name your method Terminate, which is the name of an existing method that is not virtual. So, how to get past that.
Well, if you decided on the name Terminate because your methods call the TThread.Terminate, and then do other tasks, then the framework provides you with a simple way out. Let's look at the implementation of TThread.Terminate.
procedure TThread.Terminate;
begin
if FExternalThread then
raise EThread.CreateRes(#SThreadExternalTerminate);
FTerminated := True;
TerminatedSet;
end;
Note the call to TerminatedSet. That is a virtual method whose implementation is like so:
procedure TThread.TerminatedSet;
begin
end;
It does nothing. It has been provided to allow you to override it in derived classes, and have it called whenever the non-virtual method Terminate is called.
So you would do this:
type
TMyDerivedThread = class(TThread)
protected
procedure TerminatedSet; override;
end;
....
procedure TMyDerivedThread.TerminatedSet;
begin
inherited;
// do your class specific tasks here
end;
And then the code that controls the threads can call the non-virtual Terminate method, but still have this virtual method be called.
oThread := GetNextThread;
oThread.Terminate;
Now, on the other hand, it's plausible that your Terminate methods do not call TThread.Terminate. In which case the approach would be different. You still need a virtual method, but if the TThread class does not contain an appropriate virtual already, you need to introduce one. Which means deriving a new base class in order to introduce that virtual method.
type
TBaseThread = class(TThread)
public
procedure MyTerminate; virtual; abstract;
end;
I've made this abstract but you may not want to. We can't tell because we don't know what your thread implementations do. You can decide whether or not this method should be abstract.
Now you can override this virtual method like any other, which is something I believe you already understand. The other change you need to make is that instead of holding TThread references when operating on the thread instances, you hold TBaseThread references.

How to check if a method was implemented in class Delphi

I need to check if method was implemented in class.
My classes implements an interface.
Code.
IMyInterface = interface
['{538C19EB-22E3-478D-B163-741D6BB29991}']
procedure Show();
end;
TMyClassFormCustomer = class(TInterfacedObject, IMyInterface)
public
procedure Show();
end;
TMyClassFormVendors = class(TInterfacedObject, IMyInterface)
public
procedure Show();
end;
....
procedure TMyClassFormCustomer.Show;
var
Form: TFormCustomer;
begin
Form:= TFormCustomer.Create(nil);
try
Form.ShowModal();
finally
FreeAndNil(Form)
end;
end;
{ TMyClassFormVendors }
procedure TMyClassFormVendors.Show;
begin
end;
It is possible to check if method TMyClassFormVendors.Show have implementation?
When a method not have implementation I have disable item in menu
Thanks.
I see a couple of possibilities:
If your TMyClassFormVendors does not want to do anything in .Show then simply don't declare and implement IMyInterface. In your code you can then query for that interface with if Supports(MyClass, IMyInterface) and react accordingly (Disable Menu entry)
If your IMyInterface interface actually has more than one method declared, some of which are supported (I don't want to use the word implemented, as all methods have to be implemented) and others are not, then you should better split the interface into several different ones and proceed as described in 1
You could also declare and implement another interface "ICapabilities" that could have methods like CanShow etc. In your code you could then query your class like if (Myclass as ICapabilities).CanShow then ...
I personally would favour 2. as it is the cleanest approach IMO, but it depends on what you want to do specifically
You could use similar approach as it is used for handling the event methods. So what you want to do is instead of implementing the method directly into your class you add a property which can store a method pointer to the actual method you wanna use. And then at runtime you only check to see if the pointer to such method was already assigned or not.
The code for this would look something like this:
type
//Method type object
TMyMethod = procedure (SomeParameter: Integer) of object;
TMyClass = class(TObject)
private
//Field storing pointer to the method object
FMyMethod: TMyMethod;
protected
...
public
//proerty used for assigning and accesing the method
property MyMethod: TMyMethod read FMyMethod write FMyMethod;
end;
When you are designing the method objects you can define how many and which type of parameters you wanna use in that method.
Don't forget you need to assign method to your method property in order to use it. You can do this at any time. You can even unassign it by setting it to nil if needed.
You do this in same way as you do with event methods
MyClass.MyMethod := MyProcedure;
where MyProcedure needs to have the same parameter structure as the method object type you defined earlier.
And finally you can check to see if methods has been assigned at runtime using:
if Assigned(MyClass.MyMethod) then
begin
//Do something
end
else //Skip forward
EDIT: Another advantage of this approach is that your actual method that you use can be defined and written in completely different unit.

Delphi Web Script: How to Expose a Class via RTTI which contains a Method returning another (exposed) Class

I have this Delphi class
type
TAnotherClass = class
end;
TMyClass = class
function Foo: TAnotherClass;
end;
function TMyClass.Foo: TAnotherClass;
begin
Result := TAnotherClass.Create;
end;
Now I'd like to expose this class via "dwsRTTIExposer.pas":
myUnit.ExposeRTTI(TypeInfo(TMyClass));
myUnit.ExposeRTTI(TypeInfo(TAnotherClass));
My Script looks like that:
var a: TMyClass = TMyClass.Create;
var b: TAnotherClass;
b := a.Foo;
Unfortunatelly Delphi Web Script doesn't recognize the return value from TMyClass.Foo as a valid Script Class. Is there a possibility to do that without falling back to manually expose each method with an OnEval-Eventhandler?
ExposeRTTI currently doesn't support parameters of class type.
This is because returning a direct Delphi class in the script can be problematic, as the life-cycle of Delphi objects is arbitrary and undetermined (the Delphi-side object can be destroyed at any time without notice f.i.).
You don't have to expose each method manually, you can use the RTTI exposer for every methods that involves basic types, and only have to deal manually with methods involving class types.
That'll then leave you with having to decide how you want the script-side objects to be exposed, and what their relationship to the Delphi-side object is, which is something the RTTI provides no clues about.
For instance with your original code, the OnEval code would just create a new script object that wraps the method Result for each call.
But the RTTI signature of Foo would still be exactly the same if its implementation was changed to something like
TMyClass = class
private
FFoo: TAnotherClass;
public
function Foo: TAnotherClass;
end;
function TMyClass.Foo: TAnotherClass;
begin
if FFoo=nil then
FFoo := TAnotherClass.Create;
Result := FFoo;
end;
However in that case, the OnEval would have to be completely different, as you would have to return the same script-side object on subsequent calls, and you would also need to hook the script-side object's destructor to properly handle the consequences on the private FFoo field.
Once Delphi has truly garbage-collected objects, the constraint could be relaxed, but currently the only thing that gets close is TInterfacedObject, which is unsafe, and you still have to deal with manual event handlers to handles things like circular references or classes that disable the reference counting (like the VCL components).

Calling member functions dynamically

I'm pretty sure it's possible to call a class and its member function dynamically in Delphi, but I can't quite seem to make it work. What am I missing?
// Here's a list of classes (some code removed for clarity)
moClassList : TList;
moClassList.Add( TClassA );
moClassList.Add( TClassB );
// Here is where I want to call an object's member function if the
// object's class is in the list:
for i := 0 to moClassList.Count - 1 do
if oObject is TClass(moClassList[i]) then
with oObject as TClass(moClassList[i]) do
Foo();
I get an undeclared identifier for Foo() at compile.
Clarification/Additional Information:
What I'm trying to accomplish is to create a Change Notification system between business classes. Class A registers to be notified of changes in Class B, and the system stores a mapping of Class A -> Class B. Then, when a Class B object changes, the system will call a A.Foo() to process the change. I'd like the notification system to not require any hard-coded classes if possible. There will always be a Foo() for any class that registers for notification.
Maybe this can't be done or there's a completely different and better approach to my problem.
By the way, this is not exactly an "Observer" design pattern because it's not dealing with objects in memory. Managing changes between related persistent data seems like a standard problem to be solved, but I've not found very much discussion about it.
Again, any assistance would be greatly appreciated.
Jeff
First of all you're doing something very unusual with TList: TList is a list of UNTYPED POINTERS. You can add any pointer you want to that list, and when you're doing moClassList.Add( TClassA ) you're actually adding a reference to the class TClassA to the list. Technically that's not wrong, it's just very unusual: I'd expect to see TClassList if you actually want to add a class! Or TList<TClass> if you're using a Delphi version that support it.
Then you're looping over the content of the list, and you're checking if oObject is of the type in the list. So you do want classes in that list after all. The test will work properly and test rather the object is of that type, but then when you do with oObject as TClass(moClassList[i]) do you're actually casting the object to... TObject. Not what you wanted, I'm sure!
And here you have an other problem: Using Foo() in that context will probably not work. TObject doesn't contain a Foo() method, but an other Foo() method might be available in context: That's the problem with the with keyword!
And to finally answer the question in the title bar: Delphi is not an Dynamic language. The compiler can't call a method it doesn't know about at compile time. You'll need to find a OOP way of expressing what you want (using simple inheritance or interfaces), or you may call the function using RTTI.
Edited after question clarification.
All your business classes need to implement some kind of notification request management, so your design benefits allot from a base class. Declare a base class that implements all you need, then derive all your business classes from it:
TBusinessBase = class
public
procedure RegisterNotification(...);
procedure UnregisterNotification(...);
procedure Foo;virtual;abstract;
end;
In your initial example you'd no longer need the list of supported classes. You'll simply do:
oObject.Foo;
No need for type testing since Delphi is strongly typed. No need for casting since you can declare oObject": TBusinessBase.
Alternatively, if you for some reason you can't change the inheritance for all your objects, you can use interfaces.
TClass is defined:
TClass = class of TObject;
You then write oObject as TClass which is effectively a null operation since oObject already was a TObject.
What you need is something like this:
type
TFoo = class
procedure Foo();
end;
TFooClass = class of TFoo;
TBar = class(TFoo)
procedure Bar();
end;
....
if oObject is TFooClass(moClassList[i]) then
with oObject as TFooClass(moClassList[i]) do
Foo();
This explains why your attempts to call Foo() does not compile, but I simply have no idea what you are trying to achieve. Even after your clarification I'm struggling to understand the problem.
Here's a really contrived example (using an array instead of a TList) that I think is what you're trying to do (error handling and try..finally intentionally omitted for clarity).
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
TBaseClass=class(TObject)
procedure Foo; virtual;
end;
TClassA=class(TBaseClass)
procedure Foo; override;
end;
TClassB=class(TBaseClass)
procedure Foo; override;
end;
TClassArray= array of TBaseClass;
{ TClassB }
procedure TClassB.Foo;
begin
Writeln('TClassB.Foo() called.');
end;
{ TClassA }
procedure TClassA.Foo;
begin
Writeln('TClassA.Foo() called.');
end;
var
Base: TBaseClass;
ClassArr: TClassArray;
{ TBaseClass }
procedure TBaseClass.Foo;
begin
Writeln('TBaseClass.Foo called!!!!!!!!');
end;
begin
ClassArr := TClassArray.Create(TClassA.Create, TClassB.Create);
for Base in ClassArr do
Base.Foo;
for Base in ClassArr do
Base.Free;
ReadLn;
end.

Getting object as a result from func/proc in Delphi

What is the best practice for returning simple objects from functions / procedures in delphi?
eg. 2 kinds of code:
pass created object as reference, populate object in Proc, destroy it afterwards
procedure Proc(var Obj: TMyObject);
begin
// populate Obj
end;
O := TMyObject.Create;
try
Proc(O);
// manipulate populated object
finally
O.Free;
end;
or
get created object as result from function, destroy after manipulation
function Func: TMyObj;
begin
Result := TMyObj.Create;
end;
O := Func;
if O <> nil then
begin
try
// manipulate
finally
O.Free;
end;
end;
There is no best practice. The primary thing you should do, though, is to make sure it's always clear who is responsible for destroying the object at any given time, even when an exception occurs.
There's nothing wrong with a function creating a new instance and returning it. Such a function is a factory. You can treat it just like a class's constructor, so you should make sure that it behaves like a constructor: Either return a valid object or throw an exception. It never returns a null reference.
function Func: TMyObj;
begin
Result := TMyObj.Create;
try
Result.X := Y;
except
Result.Free;
raise;
end;
end;
That's an exception-handling pattern you don't see very often, but it's important for this style of function. Returning the object transfers ownership from the function to the caller, but only if it manages to execute completely. If it has to leave early because of an exception, it frees the object because the caller has no way to free it itself. (Functions that terminate due to an exception do not have return values.) The caller will use it like this:
O := Func;
try
writeln(O.X);
finally
O.Free;
end;
If there's an exception in Func then O never gets assigned, so there's nothing available for the caller to free.
When the caller creates the object and you pass it to another function to initialize it, do not make the parameter a "var" parameter. That places certain restrictions on the caller, who must use a variable of exactly the type requested by the function, even if some descendant type was created instead.
Such a function should not free the object. The caller doesn't grant ownership responsibility to the functions it calls, especially when it plans on using the object after the function returns.
It depends on the lifetime of the object and on who is responsible for it.
Most of the time objects should be created and destroyed by the same entity.
Let's say your method fills a TStringList with results from parsing a file.
Should you let that function create the TStringList, or should you create it and pass as a reference?
I find it more readable to create it, pass it as reference, and later destroy, all in consecutive lines of code.
Now let's consider that you have a function that returns a TCustomer, for each customer added. In that case I would use a function, because I suppose that my entity would have a list, or something, of customers responsible for destroying them when not needed.
It is a common Delphi idiom to let the caller create the object and pass it as a parameter. Note that you don't have to declare it var in almost all cases.
procedure Proc (Obj : TMyObject)
begin
Obj.SomeProperty := 'SomeValue';
...
end;
Calling Code:
Obj := TMyObject.Create;
try
Proc (Obj);
finally
FreeAndNil (Obj);
end;
This avoids confusion about who has to free the object. Note that if you have a chain of method calls it can quicky become very complicated to keep track of objects that need to be freed somewhere along the line.
One more drawback: having creation and destruction scattered in the code makes it impossible to use try...finally blocks, which is just another helpful idiom to avoid resource leaks.
If you want your method to create the object, I would make it explicit in the function name, something like CreateAndInitializeList sounds right to me.
My rule is to have ownership and creation altogether. I always have the creator be the owner and thus have the responsability of destroying the object. The creation of the object is explicit in the invocation code, it is never a side effect of the invocation.
So the usual signatures of my functions are
function Func(o:tMyO): TMyO;
begin
// ....
Result := o;
end;
this way I may do either
o := func(TMyO.create);
or
o := TMyO.create;
// ...
func(o);
As mentioned, in general the same entity that created the object should free it and that means that the caller should create the object reference rather than having it done inside the function.
However, this is only possible if the caller knows the exact type of the item to be returned rather than a supertype. For instance:
var E: TEmployee;
E := CreateEmployee(EmployeeID); // Could return TEmployee or subclasses TManager or TRetiredEmployee
try
E.SendEmail(MessageText);
if (E is TRetiredEmployee) then
E.PrintLetter;
finally
E.Free;
end;
In cases like this, I find it's helpful to include the word "Create", or other indicator, in the name of the factory function I'm calling.
I often use the construct
FUNCTION SomeFunction(SL : TStrings = NIL) : TStrings;
BEGIN
IF Assigned(SL) THEN Result:=SL ELSE Result:=TStringList.Create;
// Use Result for the remainder of the function
END;
That way, I can use it both as a PROCEDURE with a passed-in reference, and as a FUNCTION which creates the instance itself.

Resources