how to call inherited constructor of TObjectDictionary in Delphi - delphi

I created the following class, after reading about the significant performance improvement of TDictionary over TStringList:
TAnsiStringList = class(TObjectDictionary<AnsiString,TObject>)
public
constructor Create(const OwnsObjects: Boolean = True); reintroduce;
destructor Destroy; override;
procedure Add(const AString: AnsiString);
procedure AddObject(const AString: AnsiString; AObject: TObject);
end;
I coded the constructor like this:
{ TAnsiStringList }
constructor TAnsiStringList.Create(const OwnsObjects: Boolean = True);
begin
if OwnsObjects then
inherited Create([doOwnsKeys,doOwnsValues])
else
inherited Create;
end;
...expecting that this TObjectDictionary constructor would be called:
constructor Create(Ownerships: TDictionaryOwnerships; ACapacity: Integer = 0); overload;
...if the Ownerships parameter were specified. If the Ownerships parameter is not specified, I expected that the following inherited TDictionary constructor would be called:
constructor Create(ACapacity: Integer = 0); overload;
The code compiles and runs, but when I call
inherited Create([doOwnsKeys,doOwnsValues]) I get the following error:
Invalid class typecast
Does anyone see what I'm doing wrong, and is there a proper way to do this?
TIA

The problem is that you are asking the container to call Free on your keys when items are removed. But your keys are not classes and so that is an invalid request. This is trapped at runtime rather than compile time because the ownership is not determined until runtime.
You only want doOwnsValues and should remove doOwnsKeys.
if OwnsObjects then
inherited Create([doOwnsValues])
else
inherited Create;
For what it is worth, if you are trying to maked an AnsiString equivalent to TStringList, then your approach is flawed. A string list is an ordered container, but a dictionary is not. You won't be able to index by integer, iterate in order and so on. I also do not understand why you would want to force all consumers of this class to declare the objects to be of type TObject. You should leave that parameter free for the consumer to specify. That's the beauty of generics.
Perhaps you don't want an ordered container, in which case a dictionary is what you need. But in that case you simply don't need to create a new class. You can simply use TObjectDictionary as is.
If you are dead set on creating a sub class then I'd do it like this:
type
TAnsiStringDict<T: class> = class(TObjectDictionary<AnsiString, T>)
That will allow the consumer of the class to decide which type of objects they put in the dictionary, and maintain compile time type safety.
So, when you want a dictionary of list boxes your declare a variable like this:
var
ListBoxDict: TAnsiStringDict<TListBox>;

Related

Spring4D - How to resolve from container with TComponent parameter to auto factory

For an example I would like to resolve a class passing in a TComponent and TNotifyEvent such as below but the base constructor of TObject gets called and not of TMy.
GlobalContainer.RegisterType<TMy>;
GlobalContainer.RegisterFactory<Func<TComponent,TNotifyEvent,TMy>>(TParamResolution.ByType);
var F:=GlobalContainer.Resolve<Func<TComponent,TNotifyEvent,TMy>>;
F(Self,Self.OnActivate);
I can get around the issue by writing some very ugly code as below but think that this kind of resolution would be so common that I must be doing something wrong.
TOther = class
end;
TMy = class
public
constructor Create(C: TComponent; N: TNotifyEvent; O: TOther);
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
GlobalContainer.RegisterType<TOther>;
GlobalContainer.RegisterType<TMy>;
GlobalContainer.RegisterType<Func<TComponent,TNotifyEvent,TMy>>(
function: Func<TComponent,TNotifyEvent,TMy>
begin
Result:=Func<TComponent,TNotifyEvent,TMy>(
function(O: TComponent; N: TNotifyEVent): TMy
begin
Result:=TMy.Create(O,N,GlobalContainer.Resolve<TOther>);
end
);
end
);
GlobalContainer.Build;
var F:=GlobalContainer.Resolve<Func<TComponent,TNotifyEvent,TMy>>;
F(Self,Self.OnActivate);
end;
constructor TMy.Create(C: TComponent; N: TNotifyEvent; O: TOther);
begin
OutputDebugString('Resolved');
end;
Thanks in advance for any pointers.
This should work now after the latest commit in develop.
The issue was the typed parameter resolution was bound to the argument type instead of the parameter type. In this case, this resulted in a typed value with type TForm2 (taken from the argument being passed) which did not match the type of the C argument of the constructor of type TComponent because that matching checks for type identity and not assignment compatibility.
After the fix typed parameter resolution works exactly on the parameter types of the factory function instead of the possibly (in case of objects) more narrow actual type of the argument.
FWIW for future reference - when registering a factory manually it's usually not necessary to use RegisterType providing the delegate but can directly use RegisterInstance like so (keep in mind that Spring.Func<...> has const` parameters) when it does not have any captured state:
GlobalContainer.RegisterInstance<Func<TComponent,TNotifyEvent,TMy>>(
function(const O: TComponent; const N: TNotifyEVent): TMy
begin
// ....
end);
Edit: I also added automatic detection for the best parameter resolution default. When the factory type is a Spring.Func<...> it automatically uses ByType so it can omitted from the RegisterFactory call. For all other types it uses ByName as default as before.

Delphi generics: How to spec "class that references its own type"

In Delphi XE2, I want to write a generic collection class which manipulates objects which must have a Copy(owntype) method, but I can't figure out how best to declare this.
I want something like this example (a collection of one item, for simplicity):
//------ Library ------
Type
TBaseCopyable = class
S: string;
// procedure Copy(OtherObject: TBaseCopyable); overload;
procedure Copy(OtherObject: TBaseCopyable); virtual;
end;
MyCollection<T: TBaseCopyable, constructor> = class
TheItem: T;
procedure SetItem(AItem: T);
function GetItem: T;
end;
[...]
function MyCollection<T>.GetItem: T;
Var
NewItem: T;
begin
NewItem := T.Create;
NewItem.Copy(TheItem);
Result := NewItem;
end;
//------ Usage ------
Type
TMyCopyable = class(TBaseCopyable)
I: integer;
// procedure Copy(OtherObject: TMyCopyable); overload;
procedure Copy(OtherObject: TMyCopyable); override;
end;
[...]
Col: MyCollection<TMyCopyable>;
The key problem is that in Col, I need the generic implementation of MyCollection to find TMyCopyable.Copy. Unsurprisingly, neither overload or virtual do the job:
With overload, the code compiles, but MyCollection.GetItem finds
TBaseCopyable.Copy, not TMyCopyable.Copy.
With virtual/override this
doesn't compile because the signatures of the two Copy declarations
don't match.
So I figure I need to use generics somehow in the specification of TBaseCopyable, possibly instead of inheritance. But I'm not sure how, primarily because I don't particularly need to feed a type parameter into TBaseCopyable, I just need the Copy argument type to refer to "the type of it's own class" in a generic way.
Ideas? Thanks!
Turn TBaseCopyable into a Generic class and apply its Generic type to Copy(), then TMyCopyable can override it, eg:
type
TBaseCopyable<T> = class
S: string;
procedure Copy(OtherObject: T); virtual;
end;
MyCollection<T: TBaseCopyable<T>, constructor> = class
TheItem: T;
procedure SetItem(AItem: T);
function GetItem: T;
end;
type
TMyCopyable = class(TBaseCopyable<TMyCopyable>)
I: integer;
procedure Copy(OtherObject: TMyCopyable); override;
end;
Alternatively, just do the same thing that TPersistent.Assign() does (since it does not use Generics):
type
TBaseCopyable = class
S: string;
procedure Copy(OtherObject: TBaseCopyable); virtual;
end;
MyCollection<T: TBaseCopyable, constructor> = class
TheItem: T;
procedure SetItem(AItem: T);
function GetItem: T;
end;
type
TMyCopyable = class(TBaseCopyable)
I: integer;
procedure Copy(OtherObject: TBaseCopyable); override;
end;
procedure TMyCopyable.Copy(OtherObject: TBaseCopyable);
begin
inherited;
if OtherObject is TMyCopyable then
I := TMyCopyable(OtherObject).I;
end;
Answering my own question, or at least summarizing findings:
So far as I can tell, there is no complete answer to the question as I posed it. What I have learned is this:
[1] Remy's solution is the way to go if the base item class (here TBaseCopyable) has no state, and either is abstract, or methods don't need to refer to other objects of the same type. (Eg: TBaseCopyable would have no fields and only abstract methods.)
[2] A significant issue is how to specify a generic class whose descendant classes can specify method arguments and return values of the same type as their enclosing class. In Remy's example, that is accomplished in the descendant class declaration:
TMyCopyable = class(TBaseCopyable<TMyCopyable>)
This means that in the generic class, T will be replaced by the ultimate class of interest.
[3] However, within TBaseCopyable's generic declaration, the information that T is always a TBaseCopyable is not available, so in TBaseCopyable's implementation, references to objects of type T won't be able to see TBaseCopyable's methods or fields.
This would be solved if we could set a constraint on T to tell the compiler that T is a TBaseCopyable.
That's apparently the approach in C#:
http://blogs.msdn.com/b/ericlippert/archive/2011/02/03/curiouser-and-curiouser.aspx
In Delphi, I think that would go like this:
type
TBaseCopyable<T: TBaseCopyable<T> > = class
...
like Remy shows for MyCollection. However, that syntax is not legal within the same class declaration (error: undeclared identifier TBaseCopyable), because TBaseCopyable is not yet fully defined. We might think to create a forward declaration for TBaseCopyable (like we would for non-generic classes), but that throws an error, and apparently it's not supported by the compiler:
How to set a forward declaration with generic types under Delphi 2010?
E2086 error with forward declaration of a generic type http://qc.embarcadero.com/wc/qcmain.aspx?d=94044
[4] Maybe the generic class could inherit the implementation?
What if we did this:
type
TBaseCopyable<T> = class(TBaseCopyableImpl) ...
That would allow TBaseCopyable to have some fields and methods that could refer to each other. However, even if those methods were virtual, they would impose fixed argument/return types on the descendants, the avoidance of which was the rationale for using generics in the first place.
So this strategy is only good for fields and methods that don't need to specialize in the descendant types... for example an object counter.
Conclusions
This question turns out to concern the somewhat-known "Curiously recurring template pattern": http://en.wikipedia.org/wiki/Curiously_recurring_template_pattern. Even though it seems what one is trying to accomplish is simple, there are theoretical problems behind the scenes.
The situation appears to call for a language keyword meaning something like "Same type as my enclosing class". However that apparently leads to covariance/contravariance issues -- violations of the rules of which types can substitute for which in inheritance hierachies. That said, it seems Delphi doesn't go as far as C# to permit as much of a partial solution.
Of course, I'd be happy to learn that there is a way to go further!
Oh, and I don't feel too bad struggling to get to the bottom of this -- even Ken Arnold thinks it's difficult: https://weblogs.java.net/blog/arnold/archive/2005/06/generics_consid.html#comment-828994
:-)

How to override an inherited property?

I have a class (TMyClass) which have a property (Items: TItems)
TItems = class;
TMyClass = class(TComponent)
private
FItems: TItems;
procedure SetItems(const Value: TItems);
protected
public
protected
property Items: TItems read FItems write SetItems;
end.
TExItems = class(TItems)
private
FNewProb: Integer;
protected
public
published
property NewProp: Integer read FNewProb write FNewProb;
end.
TExMyClass = class(TMyClass)
private
FItems: TExItems;
procedure SetItems(const Value: TItems);
protected
public
published
property Items: TExItems read FItems write SetItems;
end.
The new "Items" property is inherited from TItems but when I installed the component the new property of TExItems which is "NewProb" did not appear and it looks like the "Items" property is still TItems not TExItems...how to override it?
Thanks
Modification :
Here is the Real code
type
TKHAdvSmoothDock = class;
TKHAdvSmoothDockItem = class(TAdvSmoothDockItem)
private
FImageIndex: TImageIndex;
procedure SetImageIndex(const Value: TImageIndex);
protected
public
published
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
end;
TKHAdvSmoothDockItems = class(TAdvSmoothDockItems)
private
FOwner: TKHAdvSmoothDock;
FOnChange: TNotifyEvent;
function GetItem(Index: Integer): TKHAdvSmoothDockItem;
procedure SetItem(Index: Integer; const Value: TKHAdvSmoothDockItem);
protected
function GetOwner: TPersistent; override;
public
constructor Create(AOwner: TKHAdvSmoothDock);
function Add: TKHAdvSmoothDockItem;
function Insert(Index: Integer): TKHAdvSmoothDockItem;
property Items[Index: Integer]: TKHAdvSmoothDockItem read GetItem write SetItem; default;
procedure Delete(Index: Integer);
published
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
TKHAdvSmoothDock = class(TAdvSmoothDock)
private
FImageChangeLink: TChangeLink;
FImages: TCustomImageList;
FItems: TKHAdvSmoothDockItems;
procedure ImageListChange(Sender: TObject);
procedure SetImages(const Value: TCustomImageList);
procedure SetItems(const Value: TKHAdvSmoothDockItems);
function GetItems: TKHAdvSmoothDockItems;
{ Private declarations }
protected
procedure UpdateImagesFromImageList;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Images: TCustomImageList read FImages write SetImages;
property Items: TKHAdvSmoothDockItems read GetItems write SetItems;
end;
Regards.
Property getters and setters can be virtual, and then overridden by inheriting classes, see below for your example updated. There's one caveat with you're example code and that's you're trying to change the type of the property, which is not allowed. I would advise you check for Value is TExItems in TExMyClass.SetItems but use the inherited Items property and cast to TExItems in all methods of TExMyClass and further inheritants.
TItems = class;
TMyClass = class(TComponent)
private
FItems: TItems;
procedure SetItems(const Value: TItems); virtual;
protected
property Items: TItems read FItems write SetItems;
end;
TExItems = class(TItems)
private
FNewProb: Integer;
protected
public
published
property NewProp: Integer read FNewProb write FNewProb;
end;
TExMyClass = class(TMyClass)
private
procedure SetItems(const Value: TItems); override;
end;
Properties cannot be virtual, so they cannot be overridden. They can be hidden, in that within the context of TExMyClass, references to Items will resolve to the property declared in that class, not the one declared in the ancestor.
If you have something whose static (declared, compile-time) type is TMyClass, Items will always refer to the one from that class, even if its run-time type is TExMyClass.
You could declare SetItems as protected and virtual in the base class, and then override it in the descendant instead of declaring a whole new property that happens to have the same name.
You can implement and override methods getItem and setItem;
Implement property Item only for TMyClass
property Items: TItems read getItems write setItemps;
For TMyClass:
public:
function getItems : TItems; virtual;
procedure setItems(items: TItems); virtual;
For TExMyClass:
public:
function getItems : TItems; override;
procedure setItems(items: TItems); override;
function TExMyClass.getItems : TItems;
begin
result := fItems;
end;
procedure TExMyClass.setItems(items : TItems);
begin
self.itmes := items;
end;
so, TExMyClass.items.className = TExItems !
Technically, you can't override a property, but you can mimic override in several ways. See for example this answer for the most basic manners.
Now I do not have the code for TAdvSmoothDock so the rest is just guessing. When the property getter and setter of TAdvSmoothDock.Items are virtual, you could override them. But in more advanced components, and I suppose the ones from TMS are, then there is a good chance of TAdvSmoothDock having a protected CreateItem method which is called whenever there is need of a new item which could be overriden. If that is the case, then you should implement it like:
function TKHAdvSmoothDock.CreateItem: TAdvSmoothDockItem;
begin
Result := TKHAdvSmoothDockItem.Create;
end;
And use it like:
TKHAdvSmoothDockItem(AKHAdvSmoothDock.Items[I]).ImageIndex := ...
It is the same problem as trying to have more than one TMemo that uses the same Lines object.
Since TCustomMemo delcares on its private section FLines: TStrings; it is not possible to have more than one TMemo that uses the same FLines.
The only way (i still know) of working is to fully duplicate the whole TCustomMemo class as TLinkedCustomMemo, but defining FLines: TStrings; on the public section; also need cloning the 'TMemo' but referencing TLinkedCustomMemo, not TCustomMemo
Then using the hack of delcaring TMemo=class(TLinkedMemo) you will have public access to FLines, so you can replace that object, with the object of the main TMemo, on all the rest linked memos.
Why do such Link on the content of the TMemos?
Easy answer could be: Have more than one TMemo that shows the same text, so user can see (and edit) two (or more) different parts at a time, like some SpreadSheets do... it normally also involve an horizontal splitter between them, syncing horizontal scrollbars, etc.
Sometimes doing something that seems so easy, it is really so complicated!
Just caused by faulty on VCL design.
For the sample of the TMemos... why on the hell they have not been defined its Lines property based on TStringList insead of TStrings? That way we could use the same String List for more than one TMemo at the same time.
If want to see, how internally is dependant on such... search for class TMemoStrings (it appears on implementation section of StdCtrls). Why it must have only one TMemo?, and why it must have at all? why not had used TStringList instead of all that hell?
When some classes are so closed... it comes the hacking way of declaring classes... but how to change only a property of a control without needing to whole duplicate some classes (just to change so little things)?
Oh, yes, a real life sample for a content linked memo could be:
Let the user see (at the same time) two different parts of a text file, without double the memory storage
Or better sample: the user wants to edit a word on line 3 and another on line ten million without the need to scroll
So you put two TMemo and link the Lines property, so user has the controls to edit such Lines property (on different points) from both memo without need to scroll down and up all the times.
Another sample:
User wants to edit lines one million to one million plus twenty but needs to see lines ten to twenty at the same time.
Having to memos with a copy is not possible, more than 3GiB of RAM on a 32Bits Windows (not allowed), each Memo would need >1.6GiB of ram each... etc.
Duplicating such data is neither an option, user edit on second memo, but first must be on sync... so after loose focus (or just after edit if want good looking) you would must copy all data form one to the others memos... computing time?
-etc
There are so much samples... and most important ones are the ones i can not figure.
So answering your question in a general form, "how to hack a class to modify it a little":
Clone the code that define the class in a new unit, call that unit something that let clear it is for cloning that class with some modifications
Use the same class name only if your modifications would be backward compatile (like when additg to TEdid the Align property, use the hack of declaring it as TTheClass=class(TheUnit.TTheClass)), else use a different name
Add such new unit at the end of the uses of interface section
That is it... simple to say, hard work to do on some cases.
I allways recomend using nes classes names, except as on the sample of adding Alignment property to a TEdit.
When use the hack of declaration? When you have a full application already coded and want to add to all TEdit on it the alignment... insetead of creating a new component, adding it to component tools, redefine all forms to not use :TEdit; and use :TMyAlignedEdit... you can just simple add to uses your unit and voila... all TEdit now have such property and IDE inspertor also sees it, etc.

Should I use a class or a method to wrap a dynamic remote procedure call?

Situation
I'd like to make an RPC interface easier to use. This is a custom interface so there is no readily available wrapper.
I have to write several wrappers around functions which often have many arguments.
Possible solutions
Solution 1 - Using a class for each function:
TDoSomethingFunction = class
public
property Arg1: Integer;
property Arg2: string;
property Arg3: Boolean;
procedure Run;
end;
The caller has to create an object to call the function:
var
DoSomething: TDoSomethingFunction;
begin
DoSomething := TDoSomethingFunction.Create;
try
DoSomething.Arg1 := 0;
...
DoSomething.Run;
finally
free;
end;
Method 2 - Using a wrapper method for each function:
procedure TRPCInterface.DoSomething(AArg1: Integer; AArg2: string; AArg3: Boolean);
The caller can simply call it:
TRPCInterface.DoSomething(0, ...);
Pro and contra
Method 1 - Class for each function
Contra
More code required.
An object must be created which takes up memory.
Pro
Reading the code is easier, you don't have to look at the declaration to see what the arguments are.
Method 2 - Wrapper method
Contra
You can't tell which arguments are used by just looking at the code.
Pro
Much less code to write.
The wrapper is thinner (no object has to be created).
Which method should I use?
There is an intermediate solution that is calling the wrapper methods passing an object argument.
TDoSomethingArgs = class
public
property Arg1: Integer;
property Arg2: string;
property Arg3: Boolean;
end;
procedure TRPCInterface.DoSomething(Args: TDoSomethingArgs);
one advantage of this method is that you still use methods, but still it's more readable.
One advantage of using classes (you can also use records) in arguments is that you can later change the arguments (add more, change behavior) and if you choose it well, it does not break backward compatibility - in summary you can change method signature without breaking code.
You haven't specified Delphi version, but if yours supports generics, I would go with:
type
TArgList = class( TDictionary< String, Variant > );
type
TBaseFunc = class
private
FArgs: TArgList;
public
function Run: Boolean; virtual; abstract;
public
property Args: TVarList read FArgs write FArgs;
end;
type
TSpecialFunc = class( TBaseFunc )
public
function Run: Boolean; override;
end;
implementation
function TSpecialFunc.Run: Boolean;
begin
// here's where you can access args as variants
end;
you can use:
ASpecialFunc.Args.AddOrSetValue('ArgumentName', 2012);
in this way you will have to write more code, but it's much more readable IMHO and easy to be picked up by other developers in the future.
NOTE: that I haven't tested this code, so chances are that it won't compile.
That's my two cents, I'm very curios as to what others come up with (:

Problems passing a pointer to a constructor as a parameter

I have the following superclass:
unit DlgDefaultForm;
type
TDefaultFormDlg = class(TForm)
published
constructor Create(AOwner: TComponent); reintroduce; virtual;
end;
FormCreateFunc=function(AOwner: TComponent):TDefaultFormDlg;
which is descended by a bunch of forms as follows:
unit Form1
type
TForm1 = class(TDefaultFormDlg)
published
constructor Create(AOwner: TComponent); override;
end;
and created as follows:
unit MainForm;
procedure ShowForm(FormCreate:FormCreateFunc);
begin
(do some stuff)
FormCreate(ScrollBox1);
end;
When I run
ShowForm(#TForm1.Create);
two things happen:
When I step into TForm1.Create, AOwner=nil, even when it didn't in ShowForm.
I get an EAbstractError at the following line:
unit Forms;
(...)
constructor TCustomForm.Create(AOwner: TComponent);
begin
(...)
InitializeNewForm; //EAbstractError
(...)
end;
What am I doing wrong?
EDIT: This of course isn't my exact code.
Delphi constructors take a hidden extra parameter which indicates two things: whether NewInstance needs to be called, and what the type of the implicit first parameter (Self) is. When you call a constructor from a class or class reference, you actually want to construct a new object, and the type of the Self parameter will be the actual class type. When you call a constructor from another constructor, or when you're calling the inherited constructor, then the object instance has already been created and is passed as the Self parameter. The hidden extra parameter acts as a Boolean flag which is True for allocating a new instance but False for method-style calls of the constructor.
Because of this, you can't simply store a constructor in a method pointer[1] location and expect it to work; calling the method pointer won't pass the correct value for the hidden extra parameter, and it will break. You can get around it by declaring the parameter explicitly, and doing some typecasting. But usually it is more desirable and less error-prone to use metaclasses (class references) directly.
[1] That's another problem with your code. You're trying to store a method pointer in a function pointer location. You could do that and still make it work, but you'd need to put the declaration of Self in explicitly then, and you'd also need to pass the metaclass as the first parameter when allocating (as well as passing True for the implicit flag). Method pointers bake in the first parameter and pass it automatically. To make it all explicit, the function pointer equivalent to TComponent.Create is something like:
TComponentCreate = function(Self: Pointer; AOwner: TComponent; DoAlloc: Boolean): Pointer;
Self is a pointer here because it could be of TComponentClass type, or TComponent type, depending on whether DoAlloc is true or false.
You're not using virtual constructors correctly. Try it like this:
type
TDefaultFormDlgClass = class of TDefaultFormDlg;
function Show(FormClass: TDefaultFormDlgClass; AOwner: TComponent): TDefaultFormDlg;
begin
Result := FormClass.Create(AOwner);
end;
...
var
FormClass: TTDefaultFormDlgClass;
...
FormClass := ???;//this is where you specify the class at runtime, e.g. TForm1
MyForm := Show(FormClass, MainForm);
As an aside I do not think you need to reintroduce the constructor in the code you listed.
Based on the information from Barry I tested this code. TSample is a simple class with a paramless constructor. All you need is the pointer to the constructor (#TSample.Create) and the type of the class (TSample). If you've a hashmap key=TClass, value=Pointer ctor you can create any registered type.
type
TObjectCreate = function(Self: TClass; DoAlloc: Boolean): TObject;
var
aSample : TSample;
begin
aSample := TSample(TObjectCreate(#TSample.Create)(TSample, true));

Resources