I have CObject as main class and CRock, CDesk, CComputer as derivates from CObject. I would like to write a function that reads a class enumeration (integer probably like OBJECT_COMPUTER) and returns the specific type.
Example:
function createObject( iType : Integer ) : CObject;
begin
case iType of
OBJECT_ROCK : Result := CRock.Create();
OBJECT_DESK : Result := CDesk.Create();
end;
end;
so I can use it like this: myRock := createObject( OBJECT_ROCK );
Now my problem is that the object returned is the main class parent and I can't use Rock functions on 'myRock' without type casting 'createObject( OBJECT_ROCK )' from CObject to CRock and I don't want to have 3 functions for each sub-class. Any ideas? Thanks in advance.
If I understood correct, you'd declare a skeleton of derived functionality on the base class with abstract methods, then override and implement the method in each derived class.
type
CObject = class
procedure DoIt; virtual; abstract;
end;
CRock = class(CObject)
procedure DoIt; override;
end;
CDesk = class(CObject)
procedure DoIt; override;
end;
var
myRock: CObject;
begin
myRock := createObject(OBJECT_ROCK);
myRock.DoIt;
myRock.Free;
end;
In the above example, 'DoIt' call on the 'myRock' instance would be correctly resolved to the method of that class.
If this is relevant at all read about abstract methods here.
Like the previous example, but rather like this. We call it Inheritance, Polymorphism.
type
TcObject = class
procedure DoIt; virtual; abstract;
end;
TcRock = class(CObject)
procedure DoIt; override;
end;
TcDesk = class(CObject)
procedure DoIt; override;
end;
var
myRock: TcObject;
begin
myRock := TcRock.Create; //Inherits from TcObject and instantiate TcRock class.
myRock.DoIt; //Will automaticall call TcRock.Doit --Polymorphism
myRock.Free;
end;
Related
There are two objects: TFoo, TFoo2.
There is also a class reference : TFooClass = class of TFoo;
Both are descendants from TPersistent.
They have their own constructors:
type
TFoo = class(TPersistent)
private
FC:Char;
public
constructor Create; virtual;
published
property C:Char read FC write FC;
end;
TFoo2 = class(TFoo)
public
constructor Create; override;
end;
TFooClass = class of TFoo;
...
constructor TFoo.Create;
begin
inherited Create;
C :=' 1';
end;
constructor TFoo2.Create;
begin
inherited Create;
C := '2';
end;
I want to create a TFoo2 object from a string, which is actually its class name : 'TFoo2'
Here is the procedure, which works fine:
procedure Conjure(AClassName:string);
var
PClass : TPersistentClass;
p :TPersistent;
begin
PClass := TPersistentClass(FindClass(AClassName))
p := TFooClass(PClass).Create; // <-- here is called appropriate constructor
end;
Now, I want to have similar objects like: TBobodo, TBobodo2.
And a class reference of course : TBobodoClass = class of TBobodo;
And so on...
Now, how can I pass a class reference as a parameter into a procedure, in order to secure the right constructor is called?
procedure Conjure(AClassName:string; ACLSREF: ???? ); // <-- something like that
var
PClass : TPersistentClass;
p :TPersistent;
begin
PClass := TPersistentClass(FindClass(AClassName))
p := ACLSREF(PClass).Create; // <-- something like that
end;
Is it possible?
There is no way to do what you want in Delphi 7. The metaclass reference has to be explicit at compile-time at the call site, not handled at runtime.
In Delphi 2009 and later, you may 1 be able to do something with Generics, eg:
1: I have not tried this myself yet.
type
TConjureHelper = class
public
class procedure Conjure<TClassType>(const AClassName: string);
end;
class procedure TConjureHelper.Conjure<TClassType>(const AClassName: string);
var
PClass : TPersistentClass;
p : TPersistent;
begin
PClass := TPersistentClass(FindClass(AClassName));
p := TClassType(PClass).Create;
...
end;
...
TConjureHelper.Conjure<TFooClass>('TFoo2');
TConjureHelper.Conjure<TBobodoClass>('TBobodo2');
...
But Delphi 7 certainly does not support Generics.
I had the same problem and after some struggles, I found a quite simple solution: metaclass is invented exactly for this purpose!
In your case, you can pass the metaclass as parameter and use it directly without the cumbersome finding class and type casting.
type
TFooClass = class of TFoo;
procedure Conjure(aFooClass : TFooClass); // <-- something like that
var
p :TPersistent;
begin
p := aFooClass.Create; // it will work!
end;
and by calling, you simply use:
Conjure(TFoo); // <- for Foo class or
Conjure(TFoo2); // <- for Foo2 class and so on
I have a Base Class that needs a Prameter like Filename. This Parameter is needed for the Create Call of the TMemIniFile Class.
Whats the correct Way to call the Class function of the current Classtype inside the Base Class Constructor?
TBaseClassClass = Class of TBaseClass;
TBaseClass = class(TMemIniFile)
protected
class function FileName: string; virtual; abstract;
public
// Current Solution
constructor Create(ClassToCreate: TBaseClassClass); reintroduce;
// wanted Solution
constructor Create; reintroduce;
end;
TImplementation = Class(TBaseClass)
protected
class function FileName: string; override;
end;
// Current Solution
constructor TBaseClass.Create(ClassToCreate: TBaseClassClass);
begin
inherited Create(ClassToCreate.FileName, Encoding.UTF8);
end;
// Wanted Solution
constructor TBaseClass.Create;
begin
inherited Create(FileName, Encoding.UTF8); // This call to FileName has a Abstract Error because its calling Filename from TBaseClass. But how to solve this elegant?
end;
//Trying to Clarify: Usage:
myWorkingIniFile: TImplementation.Create; //Filename is defined in Class and the FileName value is used in the Constructor ...
Can i somehow "dynamically" Typecast inside the Constructor? I have seen the use of RTTI with a call of the function name. But i think there should be another Way.
Or am i doing it fundamentally wrong?
You should never create an instance of a class containing abstract methods. In your example, you should only create instances of TImplementation, never TBaseClass. And if you want the class to be dynamic :
procedure Foo;
var
vMyClass : TBaseClassClass;
begin
vMyClass := TImplementation; //or vMyClass := GetSomeClass();
FMyField := vMyClass.Create;
end;
In this case, you would normally want the constructor of TBaseClass to be virtual.
if you are calling TBaseClass.Create(TImplementation), you are right, that's fundamentally wrong
Oh yes thanks for the Comments. (German saying: i did not see the forest for all the trees; something like i did not see the obvious) I came up with something like this:
TBaseClass = class(TMemIniFile)
protected
class function FileName: string; virtual; abstract;
end;
TImplementation = Class(TBaseClass)
protected
class function FileName: string; override;
public
constructor Create; reintroduce;
end;
constructor TImplementation.Create;
begin
inherited Create(Filename, Encoding);
end;
Additional i now use AfterConstruction for all the other Settings and Setup. no need to use class functions.
I want to define three base classes, TMyBaseClass that keeps data, TMyBaseClassList that holds a list of instances of TMyBaseClass, and TMyBaseClassReader that scrolls through a dataset and fills a TMyBaseClassList object. This is my code:
TMyBaseClass = class
public
// properties
constructor Create;
end;
TMyBaseClassList<T: TMyBaseClass, constructor> = class(TObjectList<TMyBaseClass>)
public
function AddNew: T;
end;
TMyBaseClassReader<T: TMyBaseClass> = class
public
class procedure ReadProperties(const DataSet: TCustomADODataSet;
const Item: T); virtual; abstract;
class procedure ReadDataSet(const DataSet: TCustomADODataSet;
const List: TMyBaseClassList<T>);// <- E2513
end;
...
constructor TMyBaseClass.Create;
begin
inherited;
end;
function TMyBaseClassList<T>.AddNew: T;
begin
Result := T.Create;
Add(Result);
end;
class procedure TMyBaseClassReader<T>.ReadDataSet;
var
NewItem: T;
begin
while not DataSet.Eof do
begin
NewItem := List.AddNew;
ReadProperties(DataSet, NewItem);
DataSet.Next;
end;
end;
Then I want to derive child classes and only implement ReadProperties method. But I'm getting an E2513 error:
E2513 Type parameter 'T' must have one public parameterless constructor named Create
What is the problem and how can I fix it?
The error means that the compiler cannot be sure that T meets the requirements. Declare the derived class like so
TMyBaseClassReader<T: TMyBaseClass, constructor>
i want typecast using with class functions.
i have base (TBase),derived (TDer) and typecasting (TMyType) class.
Ver : Delphi 7
TBase = class;
TDer = class;
TMyType = class;
TBase = class
function Say : String;
class function MYType:TMyType;
end;
TDer = class(TBase)
a: string;
b: string;
function Say2 : String;
end;
TMyType=class(TBase)
class function AsDer:TDer;
end;
{ TBase }
class function TBase.MYType: TMyType;
begin
Result:=TMyType(Self);
end;
function TBase.Say: String;
begin
Result:='TBase';
end;
{ TDer }
function TDer.Say2: String;
begin
Result:='TDer';
end;
{ TMyType }
class function TMyType.AsDer: TDer;
begin
Assert(Assigned(Self));
Result := TDer(Self) ;
end;
Sample usage is below, it's calls method but when set/get field's raise error.
procedure TForm1.Button1Click(Sender: TObject);
var
b,c:TBase;
begin
b:=TDer.Create;
c:=b.MYType.AsDer;
ShowMessage(b.MYType.AsDer.Say2); // OK. Running
if (#b<>#c) then ShowMessage('Not Equal'); // Shows message, Why ?
b.MYType.AsDer.a:='hey'; // Error
FreeAndNil(b);
end;
Do you have any idea?
The fundamental problem is here:
class function TBase.MYType: TMyType;
begin
Result:=TMyType(Self);
end;
This is a class method and so Self refers to a class and not an instance. Casting it to be an instance does not make it so. Exactly the same error is made in your AsDer class function.
Looking into the specifics, the call to
b.MYType.AsDer.Say2
is benign and appears to work fine because it does not refer to Self. You could equally write TDer(nil).Say2 and that code would also work without problem. Now, if the function Say2 referred to Self, that is referred to an instance, then there would be a runtime error.
#b<>#c
always evaluates to true because you are comparing the locations of two distinct local variables.
b.MYType.AsDer.a
is a runtime error because AsDer does not return an instance of TDer. So when you attempt to write to a you have a runtime error. This is because you are referring to Self and that's why this code fails, but the earlier call to Say2 does not.
I'm not really sure what you are trying to do here, but it looks all wrong. Even if you were working with instance methods rather than class methods, it would simply be wrong to case a base class instance to a derived class instance. If something is the wrong type, no amount of casting will turn it into the right type.
Furthermore, you should never write code that has a method of TBase assuming it is of type TDerived. The base class should know absolutely nothing of its derived classes. That is one of the very basic tenets of OOP design.
Here is the edited the new version :
TBase = class;
TDer = class;
TMyType = class;
TBase = class
MYType:TMyType;
constructor Create;
destructor Destroy;
function Say : String;
end;
TDer = class(TBase)
a: string;
b: string;
function Say2 : String;
end;
TMyType=class
public
T: TObject;
function AsDer:TDer;
end;
{ TBase }
constructor TBase.Create;
begin
MYType:=TMYType.Create;
MYType.T:=TObject(Self);
end;
destructor TBase.Destroy;
begin
MYType.Free;
end;
function TBase.Say: String;
begin
Result:='TBase';
end;
{ TDer }
function TDer.Say2: String;
begin
Result:='TDer';
end;
{ TMyType }
function TMyType.AsDer: TDer;
begin
Result := TDer(T) ;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
b:TBase;
c:TDer;
begin
b:=TDer.Create;
TDer(b).a:='a';
c:=b.MYType.AsDer;
ShowMessage('b.MYType.AsDer='+b.MYType.AsDer.a+', c.a ='+ c.a); // OK. Running
FreeAndNil(b);
end;
Consider an interface like
IMyInterface = interface
procedure DoSomethingRelevant;
procedure Load (Stream : TStream);
procedure Save (Stream : TStream);
end;
and several classes that implement the interface:
TImplementingClass1 = class (TInterfacedObject, IMyInterface)
...
end;
TImplementingClass2 = class (TInterfacedObject, IMyInterface)
...
end;
...
I have a class that has a list of IMyInterface implementors:
TMainClass = class
strict private
FItems : TList <IMyInterface>;
public
procedure LoadFromFile (const FileName : String);
procedure SaveToFile (const FileName : String);
end;
Now to the question: how can I load the main class and especially the item list in an object-oriented manner? Before I can call the virtual Load method for the items, I have to create them and thus have to know their type. In my current implementation I store the number of items and then for each item
a type identifier (IMyInterface gets an additional GetID function)
call the Save method of the item
But that means that during loading I have to do something like
ID := Reader.ReadInteger;
case ID of
itClass1 : Item := TImplementingClass1.Create;
itClass2 : Item := TImplementingClass2.Create;
...
end;
Item.Load (Stream);
But that doesn't seem to be very object-oriented since I have to fiddle with existing code every time I add a new implementor. Is there a better way to handle this situation?
One solution would be to implement a factory where all classes register themselve with a unique ID.
TCustomClassFactory = class(TObject)
public
procedure Register(AClass: TClass; ID: Integer);
function Create(const ID: Integer): IMyInterface;
end;
TProductionClassFactory = class(TCustomClassFactory)
public
constructor Create; override;
end;
TTestcase1ClassFactory = class(TCustomClassFactory);
public
constructor Create; override;
end;
var
//***** Set to TProductionClassFactory for you production code,
// TTestcaseXFactory for testcases or pass a factory to your loader object.
GlobalClassFactory: TCustomClassFactory;
implementation
constructor TProductionClassFactory.Create;
begin
inherited Create;
Register(TMyImplementingClass1, 1);
Register(TMyImplementingClass2, 2);
end;
constructor TTestcase1ClassFactory.Create;
begin
inherited Create;
Register(TMyImplementingClass1, 1);
Register(TDoesNotImplementIMyInterface, 2);
Register(TDuplicateID, 1);
Register(TGap, 4);
...
end;
Advantages
You can remove the conditional logic from your current load method.
One place to check for duplicate or missing ID's.
You need a class registry, where you store every class reference together with their unique ID. The classes register themselves in the initialization section of their unit.
TImplementingClass1 = class (TInterfacedObject, IMyInterface)
...
end;
TImplementingClass2 = class (TInterfacedObject, IMyInterface)
...
end;
TMainClass = class
public
procedure LoadFromFile (const FileName : String);
procedure SaveToFile (const FileName : String);
end;
Edit: moved the class registry into a separate class:
TMyInterfaceContainer = class
strict private
class var
FItems : TList <IMyInterface>;
FIDs: TList<Integer>;
public
class procedure RegisterClass(TClass, Integer);
class function GetMyInterface(ID: Integer): IMyInterface;
end;
procedure TMainClass.LoadFromFile (const FileName : String);
...
ID := Reader.ReadInteger;
// case ID of
// itClass1 : Item := TImplementingClass1.Create;
// itClass2 : Item := TImplementingClass2.Create;
// ...
// end;
Item := TMyInterfaceContainer.GetMyInterface(ID);
Item.Load (Stream);
...
initialization
TMyInterfaceContainer.RegisterClass(TImplementingClass1, itClass1);
TMyInterfaceContainer.RegisterClass(TImplementingClass2, itClass2);
This should point you into the direction, for a very good introduction into these methods read the famous Martin Fowler article, esp. the section about Interface Injection