In Delphi 10 Seattle I want to make TProject class with structure like this:
// TProject
// Frames[]:TFrame -- all frames in project folder
// Sounds[]:TSound -- all sounds in project folder
// WorkSets[]:TWorkSet -- frames subsets for some kind of works
// WorkSetFrames[]:TWorkSetFrame
// Clips[]:TClip -- recorded clips
// ClipFrames[]:TClipFrame
and I want to have not only forward link from project to a collection and from collection to item. Also, I want to have backlinks from each final item to their owned collection and from each collection to their owner object.
Main request - all links must be correctly typed:
TProject.Clips must be type TClipCollection, derived from that basic generic collection class;
TClip must be also derived from that basic generic collection item class.
TClipCollection.Owner must be TProject
TClip.OwnerCollection must be TClipCollection
It must fill by constructors and obtain it from that basic generic classes.
And next - it must be overridable, to allow me to add property Name to generic collection item descendant and FindByName function to generic collection class and obtain a possibility to instantiate some of my collections from this two new generic classes. For example, to make TFrame and TFrameCollection with this feature.
It can be based on TCollection or TList, but it all don't have all the required features.
I have tried some declarations, but it led to class incompatibility errors (https://en.wikipedia.org/wiki/Covariance_and_contravariance_%28computer_science%29 problem noted in explanations).
UPD 1:
The last attempt to solve the problem of usage generic collection and generic collection item classes which use each other and allow override it led me to this code:
unit GenericCollection;
interface
uses Generics.Collections;
type
TGenericCollectionItem<TCollectionOwner: class> = class
public
type
TCollection = class(TList<TGenericCollectionItem<TCollectionOwner>>)
private
FOwner: TCollectionOwner;
public
property Owner: TCollectionOwner read FOwner;
constructor Create(AOwner: TCollectionOwner);
end;
private
FOwnerCollection: TCollection;
function GetIndex: Integer;
procedure SetIndex(const Value: Integer);
public
property Index: Integer read GetIndex write SetIndex;
property OwnerCollection: TCollection read FOwnerCollection;
end;
TNamedGenericCollectionItem<TCollectionOwner: class> = class(TGenericCollectionItem<TCollectionOwner>)
public
type
TNamedGenericCollection = class(TCollection)
public
function FindItemName(AName: string): TNamedGenericCollectionItem<TCollectionOwner>;
end;
private
FName: string;
public
property Name: string read FName write FName;
end;
implementation
{ TGenericCollectionItem<ACollectionOwnerType> }
function TGenericCollectionItem<TCollectionOwner>.GetIndex: Integer;
begin
Result := OwnerCollection.IndexOf(Self);
end;
procedure TGenericCollectionItem<TCollectionOwner>.SetIndex(
const Value: Integer);
var
CurIndex: Integer;
begin
CurIndex := GetIndex;
if (CurIndex >= 0) and (CurIndex <> Value) then
FOwnerCollection.Move(CurIndex, Value);
end;
{ TGenericCollectionItem<ACollectionOwnerType>.TCollection }
constructor TGenericCollectionItem<TCollectionOwner>.TCollection.Create(
AOwner: TCollectionOwner);
begin
inherited Create;
FOwner := AOwner;
end;
{ TNamedGenericCollectionItem<TCollectionOwner>.TNamedGenericCollection }
function TNamedGenericCollectionItem<TCollectionOwner>.TNamedGenericCollection.FindItemName(
AName: string): TNamedGenericCollectionItem<TCollectionOwner>;
var
X: TGenericCollectionItem<TCollectionOwner>;
begin
// TODO: Use hash-based index
for X in Self do
if TNamedGenericCollectionItem<TCollectionOwner>(X).Name = AName then
Exit(TNamedGenericCollectionItem<TCollectionOwner>(X));
end;
end.
But when I use it by declaring
TFrame = class(TNamedGenericCollectionItem<TProject>)
end;
and adding to TProject
FFrames: TFrame.TNamedGenericCollection;
this call in TProject's constructor
FFrames := TFrame.TNamedGenericCollection.Create(Self);
still geave me annoying exception:
[dcc32 Error] ProjectInfo.pas(109): E2010 Incompatible types:
'TNamedGenericCollectionItem<TCollectionOwner>.TNamedGenericCollection' and
'GenericCollection.TNamedGenericCollectionItem<ProjectInfo.TProject>.TNamedGenericCollection'
What I can do to solve this?
I really think that you are over-thinking this. Once I got my head round what you are trying to do, you just want the owner to know what sort its items are (which TObjectList< T > for example already knows) and for the item to know what its owner is, which is easily constructed.
unit Unitgenerics;
interface
uses
System.Generics.Collections;
type
TGItem<TOwner : class> = class
private
fOwner: TOwner;
public
constructor Create( const pOwner : TOwner );
property Owner : TOwner
read fOwner;
end;
TRealItem = class;
TRealOwner = class( TObjectList<TRealItem> )
// Items are already of type TRealItem
end;
TRealItem = class(TGItem< TRealOwner > )
// Owner already defined and is of type TRealOwner
end;
implementation
{ TGItem<TOwner> }
constructor TGItem<TOwner>.Create(const pOwner: TOwner);
begin
inherited Create;
fOwner := pOwner;
end;
end.
To extend this down to descendants, that is easy enough for the items if the owner didn't change. But it does. However all we need to do is use generics to reflect to the descendants how the owner changes - like this
unit Unitgenerics;
interface
uses
System.Generics.Collections;
type
TGItem<TOwner : class> = class
private
fOwner: TOwner;
public
constructor Create( const pOwner : TOwner );
property Owner : TOwner
read fOwner;
end;
TRealItem< TOwner : class > = class;
TRealOwner<TOwner : class> = class( TObjectList<TRealItem< TOwner >> )
// Items are already of type TRealItem<TOwner>
end;
TRealItem< TOwner : class > = class(TGItem< TRealOwner<TOwner> > )
// Owner already defined and is of type TRealOwner<TOwner>
end;
implementation
{ TGItem<TOwner> }
constructor TGItem<TOwner>.Create(const pOwner: TOwner);
begin
inherited Create;
fOwner := pOwner;
end;
end.
This is how to extend further without nesting generics too far...
unit Unitgenerics;
interface
uses
System.Generics.Collections;
type
TGItem<TOwner : class> = class
private
fOwner: TOwner;
public
constructor Create( const pOwner : TOwner );
property Owner : TOwner
read fOwner;
end;
TRealItem< TOwner : class > = class;
TRealOwner<TOwner : class> = class( TObjectList<TRealItem< TOwner >> )
// Items are already of type TRealItem
// add some properties here
end;
TRealItem< TOwner : class > = class(TGItem< TRealOwner<TOwner> > )
// Owner already defined and is of type TRealOwner
// add some properties here
end;
T2ndLevelItem = class;
T2ndLevelOwner = class;
T2ndLevelOwner = class( TRealOwner< T2ndLevelOwner > )
end;
T2ndLevelItem = class( TRealItem< T2ndLevelOwner > )
end;
TInheritable2ndLevelItem< TOwner : class> = class;
TInheritable2ndLevelOwner< TOwner : class> = class;
TInheritable2ndLevelOwner< TOwner : class> = class( TRealOwner< TOwner > )
end;
TInheritable2ndLevelItem< TOwner : class> = class( TRealItem< TOwner > )
end;
T3rdLevelItem = class;
T3rdLevelOwner = class;
T3rdLevelOwner = class( TRealOwner< T3rdLevelOwner > )
end;
T3rdLevelItem = class( TRealItem< T3rdLevelOwner > )
end;
TInheritable3rdLevelItem< TOwner : class> = class;
TInheritable3rdLevelOwner< TOwner : class> = class;
TInheritable3rdLevelOwner< TOwner : class> = class( TInheritable2ndLevelOwner< TOwner > )
end;
TInheritable3rdLevelItem< TOwner : class> = class( TInheritable2ndLevelItem< TOwner > )
end;
implementation
{ TGItem<TOwner> }
constructor TGItem<TOwner>.Create(const pOwner: TOwner);
begin
inherited Create;
fOwner := pOwner;
end;
end.
UPD1
I updated your example using my principles. In the process I realised that your main problem was dealing with the fact that the top level item is, in fact, a list. You are trying to explain this to the compiler with your convoluted constructs, but that is not the way to do it.
interface
uses
System.Generics.Collections;
type
TGenericCollectionItem< TOwnerCollection : class > = class
private
FOwnerCollection: TList<TOwnerCollection>;
function GetIndex: Integer;
procedure SetIndex(const Value: Integer);
public
constructor Create(pOwnerCollection: TList<TOwnerCollection>);
property Index: Integer read GetIndex write SetIndex;
property OwnerCollection: TList<TOwnerCollection> read FOwnerCollection;
end;
TNamedGenericCollectionItem<TOwnerCollection: class> = class(TGenericCollectionItem< TOwnerCollection>)
public
private
FName: string;
public
property Name: string read FName write FName;
end;
type
TFrames = class;
TProject = class( TList< TFrames > )
private
FFrames : TFrames;
public
constructor Create;
end;
TFrames = class(TNamedGenericCollectionItem< TFrames>)
end;
implementation
{ TGenericCollectionItem<ACollectionOwnerType> }
constructor TGenericCollectionItem<TOwnerCollection>.Create(
pOwnerCollection: TList<TOwnerCollection>);
begin
inherited Create;
pOwnerCollection := fOwnerCollection;
end;
function TGenericCollectionItem<TOwnerCollection>.GetIndex: Integer;
begin
Result := OwnerCollection.IndexOf(Self);
end;
procedure TGenericCollectionItem<TOwnerCollection>.SetIndex(
const Value: Integer);
var
CurIndex: Integer;
begin
CurIndex := GetIndex;
if (CurIndex >= 0) and (CurIndex <> Value) then
FOwnerCollection.Move(CurIndex, Value);
end;
{ TProject }
constructor TProject.Create;
begin
inherited Create;
FFrames:= TFrames.Create( self );
end;
I hope that this helps.
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 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>
Can someone explain why in the code below, class1List does not require class1 to have a parameterless constructor, but class2list does require class 2 to have a parameterless constructor.
unit Unit11;
interface
uses
System.Generics.Collections;
type
class1 = class
public
constructor Create( const i : integer ); virtual;
end;
class1List<T : class1 > = class( TObjectList< T > )
public
function AddChild( const i : integer ) : T;
end;
class2 = class
public
constructor Create( const i : integer );
end;
class2List<T : class2 > = class( TObjectList< T > )
public
function AddChild( const i : integer ) : T;
end;
implementation
{ class1List<T> }
function class1List<T>.AddChild(const i: integer): T;
begin
Result := T.Create( i );
inherited Add( Result );
end;
{ class2List<T> }
function class2List<T>.AddChild(const i: integer): T;
begin
Result := T.Create( i );
inherited Add( Result );
end;
{ class1 }
constructor class1.Create(const i: integer);
begin
end;
{ class2 }
constructor class2.Create(const i: integer);
begin
end;
end.
function class1List<T>.AddChild(const i: integer): T;
begin
Result := T.Create( i );
inherited Add( Result );
end;
The constructor of class1 is declared virtual. Therefore the compiler knows that T.Create yields an instance of T whose intended constructor has been called. Hence the compiler accepts this code. Note that earlier versions of the compiler would reject this code and force you to use the following cast
Result := T(class1(T).Create( i ));
But more recent versions of the compiler have removed the need for such trickery.
function class2List<T>.AddChild(const i: integer): T;
begin
Result := T.Create( i );
inherited Add( Result );
end;
The constructor of class2 is not virtual and so the compiler knows that were it to call the constructor of class2, likely the class would not be properly initialised. It is prepared to call a parameterless constructor from the specialised type T if one exists, and you apply the constructor constraint when you declare the generic type. However, the language offers no way to apply a constructor constraint for constructors that accept parameters.
Now, you could apply the constructor constraint, but that would do no good. In order for the instance to be initialised properly, you need to call the constructor with the parameter. Which means, in practical terms, that you should use the first approach using a virtual constructor.
Don't be tempted to cast your way out of this hole. This code will compile
Result := T(class2(T).Create( i ));
but will likely not do what you want. This will call the static constructor of class2 which is surely not what you want.
I have a base class test define below
type
Tinfo = procedure of object;
Test = class(TObject)
public
procedure Add ( const a : Tinfo ); reintroduce ;
end;
procedure Test.Add(const a: Tinfo);
begin
Writeln('base class add function');
// dosomething more
end;
and I have a derived generic class from this base class
TTesting<T> = class(Test)
public
procedure Add ( const a : T ); reintroduce ;
end;
and I am typecasting T to Tinfo but it gives me the error
procedure TTesting<T>.Add(const a : T );
begin
inherited Add(Tinfo(a) ); // gives me error here
end;
is there any way I can implement this?
First your cast is wrong, you obviously want to cast a and not T.
However if you want to type cast on a procedure of object which is a type that cannot be polymorphic in any way it makes no sense to put that into a generic type at all.
What should T be? It only can be a TInfo in your code.
If you however want T to be any event/method type you should store a TMethod in your base class and then work with that in your generic class. But remember that you cannot have a constraint that limits T to be an event type. So you might check that in your constructor.
type
PMethod = ^TMethod;
Test = class(TObject)
public
procedure Add(const a: TMethod ); reintroduce ;
end;
procedure Test.Add(const a: TMethod);
begin
Writeln('base class add function');
// dosomething more
end;
type
TTesting<T> = class(Test)
public
constructor Create;
procedure Add(const a: T); reintroduce ;
end;
constructor TTesting<T>.Create;
begin
Assert(PTypeInfo(TypeInfo(T)).Kind = tkMethod);
inherited Create;
end;
procedure TTesting<T>.Add(const a: T);
begin
inherited Add(PMethod(#a)^);
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