I have a main class and several inherited classes that implement a method with the same name, like this:
MainClass = class(TImage)
//main class methods...
end;
MyClass1 = class(MainClass)
procedure DoSomething;
end;
MyClass2 = class(MainClass)
procedure DoSomething;
end;
MyClass3 = class(MainClass)
procedure DoSomething;
end;
I also have a TList containing pointers to object instances (of several classes).
If I want to call the right DoSomething procedure for each class, do I use the following?
if TList[i] is MyClass1 then
MyClass1(TList[i]).DoSomething
else if TList[i] is MyClass2 then
MyClass2(TList[i]).DoSomething
else if TList[i] is MyClass3 then
MyClass3(TList[i]).DoSomething
Is there some casting method that allows me to do this in a few lines of code?
Yes, virtual polymorphism :)
MainClass = class(TImage)
procedure DoSomething; virtual;
end;
MyClass1 = class(MainClass)
procedure DoSomething; override;
end;
MyClass2 = class(MainClass)
procedure DoSomething; override;
end;
MyClass3 = class(MainClass)
procedure DoSomething; override;
end;
And then just:
if TList[i] is MainClass then
MainClass(TList[i]).DoSomething
If you don't want to do an empty MainClass.DoSomething procedure, you can also mark it virtual; abstract;.
The virtual inheritance answer is the best for the situation you described where the classes descend from a common base class, but if you have a situation where there is not a common base class between your classes and you need this behavior, you can use interfaces instead to achieve the same result:
IMainInterface = interface
['{0E0624C7-85F5-40AF-ADAC-73B7D79C264E}']
procedure DoSomething;
end;
MyClass = class(TInterfacedObject, IMainInterface)
procedure DoSomething;
destructor Destroy; override;
end;
MyClass2 = class(TInterfacedObject, IMainInterface)
procedure DoSomething;
end;
MyClass3 = class(TInterfacedObject, IMainInterface)
procedure DoSomething;
end;
and then using it would look something like this:
var
i: integer;
list: TInterfaceList;
main: IMainInterface;
begin
list := TInterfaceList.Create;
list.Add(MyClass.create);
list.Add(MyClass2.Create);
list.Add(MyClass3.Create);
for i := 0 to 2 do
if Supports(list[i], IMainInterface, main) then
main.DoSomething;
list.Free;
Related
There is a TBaseClassList<T: TBaseClass> class that has virtual method DoSomething. I want to call this method from another open constructed type method outside of TBaseClassList and its descendants called CallDoSomething. This is my code:
type
TBaseClass = class end;
TBaseClassList<T: TBaseClass> = class
class procedure DoSomething; virtual; abstract;
end;
TSubClass1 = class(TBaseClass) end;
TSubClass1List = class(TBaseClassList<TSubClass1>)
class procedure DoSomething; override;
end;
TDoSomethingCaller = class
class procedure CallDoSomething<T: TBaseClass; L: TBaseClassList<T>>;
end;
implementation
class procedure TSubClass1List.DoSomething;
begin
ShowMessage('TSubClass1List.DoSomething');
end;
class procedure TDoSomethingCaller.CallDoSomething<T, L>;
begin
L.DoSomeThing;
end;
initialization
TDoSomethingCaller.CallDoSomething<TSubClass1, TSubClass1List>;
end.
Now, am I doing it in a right way? Is it possible to define CallDoSomething with only one type parameter?
Other definitions of CallDoSomething that I tried are:
Method 1:
class procedure CallDoSomething<L: TBaseClassList>;
My Delphi doesn't compile it (I'm using 10.1 Berlin). It says:
E2003 Undeclared identifier: 'TBaseClassList'
Method 2:
class procedure CallDoSomething<T: TBaseClass>;
...
class procedure TDoSomethingCaller.CallDoSomething<T>;
begin
TBaseClassList<T>.DoSomething;
end;
It has a runtime error:
Project raised exception class EAbstractError with message 'Abstract Error'.
Method 3:
class procedure CallDoSomething<L: TSubClass1List>;
Now I can't call CallDoSomething for TSubClass2List.
P.S. I didn't even know how to put my question in words, so, any suggestions for a better title or description will be appreciated.
This is how I would do it
type
TBaseClass = class
end;
TBaseClassList = class
class procedure DoSomething; virtual; abstract;
end;
TBaseClassList<T: TBaseClass> = class(TBaseClassList)
end;
TSubClass1 = class(TBaseClass)
end;
TSubClass1List = class(TBaseClassList<TSubClass1>)
class procedure DoSomething; override;
end;
TDoSomethingCaller = class
class procedure CallDoSomething<L: TBaseClassList>;
end;
implementation
class procedure TSubClass1List.DoSomething;
begin
inherited;
ShowMessage('TSubClass1List.DoSomething');
end;
class procedure TDoSomethingCaller.CallDoSomething<L>;
begin
L.DoSomething;
end;
initialization
TDoSomethingCaller.CallDoSomething<TSubClass1List>;
end.
I create my own class and I want to use it in my new component but I am getting an error...
The code is the following:
type
TMyClass = class
Name: string;
Number: double;
end;
TMyComponent = class(TCustomPanel)
private
FMyClass: TMyClass;
public
procedure SetMyClass(aName: string; aNumber: double);
published
property MyClass: TMyClass write SetMyClass;
end;
procedure SetMyClass(aName: string; aNumber: double);
begin
FMyClass.Name:= aName;
FMyClass.Number:= aNumber;
end;
it appears that the property has incompatible types, I don't know why.
Does anybody has a clue about that and how can I solve this problem.
Having a FName and FNumber as fields in TMyComponent is not an option, my code is more complex and this is a simple example to explain my goal.
thanks
The things that I can see wrong with your code at present are:
The property setter must receive a single parameter of the same type as the property, namely TMyClass.
The property setter must be a member of the class, but you've implemented it as a standalone procedure.
A published property needs to have a getter.
So the code would become:
type
TMyClass = class
Name: string;
Number: double;
end;
TMyComponent = class(TCustomPanel)
private
FMyClass: TMyClass;
procedure SetMyClass(Value: TMyClass);
published
property MyClass: TMyClass read FMyClass write SetMyClass;
end;
procedure TMyComponent.SetMyClass(Value: TMyClass);
begin
FMyClass.Name:= Value.Name;
FMyClass.Number:= Value.Number;
end;
This code does not instantiate FMyClass. I'm guessing that the code that does instantiate FMyClass is part of the larger component code that has been excised for the sake of this question. But obviously you do need to instantiate FMyClass.
An alternative to instantiating FMyClass is to turn TMyClass into a record. Whether or not that would suit your needs I cannot tell.
It looks like you are having some problems instantiating this object. Do it like this:
type
TMyClass = class
Name: string;
Number: double;
end;
TMyComponent = class(TCustomPanel)
private
FMyClass: TMyClass;
procedure SetMyClass(Value: TMyClass);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property MyClass: TMyClass read FMyClass write SetMyClass;
end;
constructor TMyComponent.Create(AOwner: TComponent);
begin
inherited;
FMyClass:= TMyClass.Create;
end;
destructor TMyComponent.Destroy;
begin
FMyClass.Free;
inherited;
end;
procedure TMyComponent.SetMyClass(Value: TMyClass);
begin
FMyClass.Name:= Value.Name;
FMyClass.Number:= Value.Number;
end;
One final comment. Using MyClass for an object is a bad name. Use class for the type, and object for the instance. So, your property should be MyObject and the member field should be FMyObject etc.
Try this:
type
TMyClass = class
Name: string;
Number: double;
end;
TMyComponent = class(TCustomPanel)
private
FMyClass: TMyClass;
public
procedure SetMyClass(Value: TMyClass);
published
property MyClass: TMyClass write SetMyClass;
end;
procedure TMyComponent.SetMyClass(Value);
begin
FMyClass := Value;
end;
unit MyComponentTest2;
interface
uses SysUtils, Classes, Controls, Forms, ExtCtrls, Messages, Dialogs;
type
TMyClass = class
Name: string;
Number: double;
end;
TMyComponentTest2 = class(TCustomPanel)
private
FMyClass: TMyClass;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetMyClass(Value: TMyClass);
published
property MyClass: TMyClass read FMyClass write SetMyClass;
end;
procedure Register;
implementation
constructor TMyComponentTest2.Create(AOwner: TComponent);
begin
Inherited Create(AOwner);
FMyClass:= TMyClass.Create;
end;
destructor TMyComponentTest2.Destroy;
begin
Inherited;
FMyClass.Free;
end;
procedure TMyComponentTest2.SetMyClass(Value: TMyClass);
begin
FMyClass.Name:= Value.Name;
FMyClass.Number:= Value.Number;
end;
procedure Register;
begin
RegisterComponents('MyComponents', [TMyComponentTest2]);
end;
end.
I am working on a component that is derived from a commercial component suite, and have run into a challenge, which I've never considered before. Consider the following code snippet:
TMyClass = class
protected
procedure SomeMethod; virtual;
end;
TMyClass1 = class(TMyClass)
protected
procedure SomeMethod; override;
end;
TMyMode = (mmOne, mmTwo);
TMyClass2 = class(TMyClass1)
private
FMode: TMyMode;
protected
procedure SomeMethod; override;
public
property Mode: TMyMode read FMode write FMode;
end;
...
procedure TMyClass2.SomeMethod;
begin
if FMode = mmOne then inherited SomeMethod
else inherited TMyClass.SomeMethod;
end;
So if Mode = mmOne then I inherit as normal, but if it is mmTwo, I still want to inherit the code from my ancestor's ancestor, but not what was introduced in the ancestor. I've tried the above, with no success, and since I've never encountered this before, I gather it's not possible. Any takers?
You can do this with class helpers:
type
TA = class
public
procedure X; virtual;
end;
TB = class(TA)
public
procedure X; override;
end;
TA_Helper = class helper for TA
procedure A_X;
end;
TC = class(TB)
public
procedure X; override;
end;
procedure TA.X;
begin
// ...
end;
procedure TB.X;
begin
// ...
end;
procedure TA_Helper.A_X;
begin
inherited X; // TA.X
end;
procedure TC.X;
begin
A_X;
inherited X; // TB.X
end;
I think class helpers exist in D2006, but if they don't, you can also use a hack to the same effect:
// ...
TA_Helper = class(TA)
procedure A_X;
end;
// ...
procedure TC.X;
begin
TA_Helper(Self).A_X;
inherited X; // TB.X
end;
there is another solution of this task without class-helpers or additional methods (as in #hvd answer). you can get base class methods code address and invoke it with self Data-pointer:
updated code, without rtti
unit Unit4;
interface
type
TA = class(TObject)
protected
procedure Test(); virtual;
end;
TB = class(TA)
protected
procedure Test(); override;
end;
TC = class(TB)
public
procedure Test(); override;
end;
implementation
procedure TA.Test;
begin
writeln('TA.Test()');
end;
procedure TB.Test;
begin
writeln('TB.Test');
end;
procedure TC.Test;
var TATest : procedure of object;
begin
writeln('TC.Test();');
writeln('call inherited TB: ');
inherited Test();
writeln('call inherited TA:');
TMethod(TATest).Data := self;
TMethod(TATest).Code := #TA.Test;
TATest();
end;
end.
TMyBaseClass=class
constructor(test:integer);
end;
TMyClass=class(TMyBaseClass);
TClass1<T: TMyBaseClass,constructor>=class()
public
FItem: T;
procedure Test;
end;
procedure TClass1<T>.Test;
begin
FItem:= T.Create;
end;
var u: TClass1<TMyClass>;
begin
u:=TClass1<TMyClass>.Create();
u.Test;
end;
How do I make it to create the class with the integer param. What is the workaround?
Just typecast to the correct class:
type
TMyBaseClassClass = class of TMyBaseClass;
procedure TClass1<T>.Test;
begin
FItem:= T(TMyBaseClassClass(T).Create(42));
end;
Also it's probably a good idea to make the constructor virtual.
You might consider giving the base class an explicit method for initialization instead of using the constructor:
TMyBaseClass = class
public
procedure Initialize(test : Integer); virtual;
end;
TMyClass = class(TMyBaseClass)
public
procedure Initialize(test : Integer); override;
end;
procedure TClass1<T>.Test;
begin
FItem:= T.Create;
T.Initialize(42);
end;
Of course this only works, if the base class and all subclasses are under your control.
Update
The solution offered by #TOndrej is far superior to what I wrote below, apart from one situation. If you need to take runtime decisions as to what class to create, then the approach below appears to be the optimal solution.
I've refreshed my memory of my own code base which also deals with this exact problem. My conclusion is that what you are attempting to achieve is impossible. I'd be delighted to be proved wrong if anyone wants to rise to the challenge.
My workaround is for the generic class to contain a field FClass which is of type class of TMyBaseClass. Then I can call my virtual constructor with FClass.Create(...). I test that FClass.InheritsFrom(T) in an assertion. It's all depressingly non-generic. As I said, if anyone can prove my belief wrong I will upvote, delete, and rejoice!
In your setting the workaround might look like this:
TMyBaseClass = class
public
constructor Create(test:integer); virtual;
end;
TMyBaseClassClass = class of TMyBaseClass;
TMyClass = class(TMyBaseClass)
public
constructor Create(test:integer); override;
end;
TClass1<T: TMyBaseClass> = class
private
FMemberClass: TMyBaseClassClass;
FItem: T;
public
constructor Create(MemberClass: TMyBaseClassClass); overload;
constructor Create; overload;
procedure Test;
end;
constructor TClass1<T>.Create(MemberClass: TMyBaseClassClass);
begin
inherited Create;
FMemberClass := MemberClass;
Assert(FMemberClass.InheritsFrom(T));
end;
constructor TClass1<T>.Create;
begin
Create(TMyBaseClassClass(T));
end;
procedure TClass1<T>.Test;
begin
FItem:= T(FMemberClass.Create(666));
end;
var
u: TClass1<TMyClass>;
begin
u:=TClass1<TMyClass>.Create(TMyClass);
u.Test;
end;
Another more elegant solution, if it is possible, is to use a parameterless constructor and pass in the extra information in a virtual method of T, perhaps called Initialize.
What seems to work in Delphi XE, is to call T.Create first, and then call the class-specific Create as a method afterwards. This is similar to Rudy Velthuis' (deleted) answer, although I don't introduce an overloaded constructor. This method also seems to work correctly if T is of TControl or classes like that, so you could construct visual controls in this fashion.
I can't test on Delphi 2010.
type
TMyBaseClass = class
FTest: Integer;
constructor Create(test: integer);
end;
TMyClass = class(TMyBaseClass);
TClass1<T: TMyBaseClass, constructor> = class
public
FItem: T;
procedure Test;
end;
constructor TMyBaseClass.Create(test: integer);
begin
FTest := Test;
end;
procedure TClass1<T>.Test;
begin
FItem := T.Create; // Allocation + 'dummy' constructor in TObject
try
TMyBaseClass(FItem).Create(42); // Call actual constructor as a method
except
// Normally this is done automatically when constructor fails
FItem.Free;
raise;
end;
end;
// Calling:
var
o: TClass1<TMyClass>;
begin
o := TClass1<TMyClass>.Create();
o.Test;
ShowMessageFmt('%d', [o.FItem.FTest]);
end;
type
TBase = class
constructor Create (aParam: Integer); virtual;
end;
TBaseClass = class of TBase;
TFabric = class
class function CreateAsBase (ConcreteClass: TBaseClass; aParam: Integer): TBase;
class function CreateMyClass<T: TBase>(aParam: Integer): T;
end;
TSpecial = class(TBase)
end;
TSuperSpecial = class(TSpecial)
constructor Create(aParam: Integer); override;
end;
class function TFabric.CreateAsBase(ConcreteClass: TBaseClass; aParam: Integer): TBase;
begin
Result := ConcreteClass.Create (aParam);
end;
class function TFabric.CreateMyClass<T>(aParam: Integer): T;
begin
Result := CreateAsBase (T, aParam) as T;
end;
// using
var
B: TBase;
S: TSpecial;
SS: TSuperSpecial;
begin
B := TFabric.CreateMyClass <TBase> (1);
S := TFabric.CreateMyClass <TSpecial> (1);
SS := TFabric.CreateMyClass <TSuperSpecial> (1);
Why in the code below, do I get the "Failed" message rather than "Succeeded"
Background: I like to have class procedures that instantiate their owner object, do something, and then free it.
However, this approach doesn't work if I have a descendant object:
Any suggestions on how to provide class procedures in a base class that can be called as a child? Am I thinking about this wrongly?
Type
TBase = class(TObject)
Protected
Procedure Proc1; Virtual;
Public
Class Procedure MyClassProc;
end;
Class Procedure TBase.MyClassProc;
Var
Base: TBase;
begin
Base := TBase.Create;
Base.Proc1;
Base.Free;
end;
Procedure TBase.Proc1;
begin
Assert(FALSE, 'Failed');
end;
type
TChild = class(TBase)
protected
Procedure Proc1; Override;
end;
Procedure TChild.Proc1;
begin
ShowMessage('Succeeded');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TChild.MyClassProc;
end;
You can do it easily with meta-programmation! Just change "TBase.Create" to "Self.Create" "self" represents the current class, it doesn't metter if is a base o a child class.
Type
TBase = class(TObject)
Protected
Procedure Proc1; Virtual;
Public
Class Procedure MyClassProc;
end;
Class Procedure TBase.MyClassProc;
Var
MyObject: TBase;
begin
// MyObject := TBase.Create;
MyObject := Self.Create; // The Magic goes here, self is the class that's calling this method, in this case, TChild }
MyObject.Proc1;
MyObject.Free;
end;
Procedure TBase.Proc1;
begin
Assert(FALSE, 'Failed');
end;
type
TChild = class(TBase)
protected
Procedure Proc1; Override;
end;
Procedure TChild.Proc1;
begin
ShowMessage('Succeeded');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TChild.MyClassProc;
end;
Strip everything down to the bare minimum, and you will see that you only ever create a TBase instance, so consequently only TBase.Proc1() will ever be called. If you want to have TChild.Proc1() be called you need to create a TChild instance and let polymorphism work its magic.
There could however be better ways to achieve your goal (whatever it is) than to have a class method create an object instance to do something. Maybe you should clarify your question.
Here it is
Add
TBase = class;
TBaseClass = class of TBase;
TBase = class(TObject)
protected
class function GetBaseClass: TBaseClass; virtual;
function TBase.GetBaseClass: TBaseClass;
begin
Result := TBase;
end;
TChild = class(TBase)
protected
class function GetBaseClass: TBaseClass; override;
function TChild.GetBaseClass: TBaseClass;
begin
Result := TChild;
end;
Change
from
Base := TBase.Create;
to
Base := GetBaseClass.Create;
Enjoy your work
Cheer
A Pham