i don't have much experience with interfaces in Delphi and Delphi at all.
Example:
IListModel = interface
function At(row, col : Integer) : String;
end;
MyModel = class(TInterfacedObject, IListModel)
public
function At(row, col : Integer) : String;
procedure ManipulateA;
procedure ManipulateBogus;
end;
There is a view that can visualize objects that implement the IListModel interface.
View = class(TForm)
public
constructor Create(model : IListModel); reintroduce;
end;
My app holds a MyModel instance
MyApp = class({...})
strict private
model : MyModel;
public
// ...
end;
In the app i create the model and work with it.
procedure MyApp.LoadModel;
procedure MyApp.OnFoo;
begin
model.ManipulateBogus;
end;
Now, i want to show the data
procedure MyApp.ShowModel;
var
v : View;
begin
v := View.Create(model); // implicit to IListView > refCount=1
v.ShowModal;
FreeAndNil(v);
// refCount = 0
// oops, my model is dead now
end;
I'm wondering what's the best way to solve this problem.
In MyApp i could hold both, the instance model : MyModel AND via IListModel interface.
Or I could introduce a new interface IMyModel and hold the model by this interface in the MyApp class. I had to use if Supports(...) in the ShowModel method to get the IListModel interface.
Or i derive the MyModel class from another non refcounting base class (TInterfacedPersistent or a self written class). Any other ideas?
What is the best way to work with interfaces in such situations?
Edit:
A non ref counting base class:
function NonRefCountingObject.QueryInterface(const IID: TGUID;
out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := S_OK
else
Result := E_NOINTERFACE;
end;
function NonRefCountingObject._AddRef: Integer;
begin
Result := -1; // no reference counting
end;
function NonRefCountingObject._Release: Integer;
begin
Result := -1; // no reference counting
end;
Is this implementation ok?
If you want to use the reference counting that comes with interfaces, you should only reference that object through interfaces. No references to the object other than through interfaces and do not free the object yourself.
Or you could disable the reference counting by overriding _AddRef and _Release and destroy the object like you are used to. This is what TComponent does.
Or keep the reference counting, but call AddRef and Release when you reference it like an object.
edit
using a const parameter prevents reference count updating and speeds up your code:
constructor Create(const model : IListModel); reintroduce;
If you need both, Interfaces and object references, simply derive from TInterfacedPersistent (declared in Classes.pas) instead of TInterfacedObject. Be aware that you must assure that no interface reference is still hold when you free the instance.
Related
Here is the object:
TCell = class(TPersistent)
private
FAlignmentInCell :byte;
public
constructor Create; virtual;
published
property AlignmentInCell:byte read FAlignmentInCell write FAlignmentInCell;
end;
this is its constructor:
constructor TCell.Create;
begin
inherited;
FAlignmentInCell:=5;
end;
Here is a function, which dynamically creates any object derived form TPersistent (parameter is class name provided as a string)
function CreateObjectFromClassName(AClassName:string):TPersistent;
var DynamicObject:TPersistent;
TempObject:TPersistent;
DynamicPersistent:TPersistent;
DynamicComponent:TComponent;
PersistentClass:TPersistentclass;
ComponentClass:TComponentClass;
begin
PersistentClass:=TPersistentclass(FindClass(AClassName));
TempObject:=PersistentClass.Create;
if TempObject is TComponent then
begin
ComponentClass:=TComponentClass(FindClass(AClassName));
DynamicObject:=ComponentClass.Create(nil);
end;
if not (TempObject is TComponent) then
begin
DynamicObject:=PersistentClass.Create; // object is really TCell, but appropriate constructor seems to be not called.
end;
result:=DynamicObject;
end;
My idea is to create new Cell (TCell) like this:
procedure TForm1.btn1Click(Sender: TObject);
var p:TPersistent;
begin
p := CreateObjectFromClassName('TCell');
ShowMessage(IntToStr(TCell(p).AlignmentInCell)); // it is 0. (Why?)
end;
When I want to check AlignmentInCell property I get 0, but I expected 5. Why? Is there way to fix it?
This is similar to a recent question.
You use TPersistentClass. But TPersistent does not have a virtual constructor, so the normal constructor for TPersistent is called, which is the constructor it inherits from TObject.
If you want to call the virtual constructor, you will have to declare a
type
TCellClass = class of TCell;
Now you can modify CreateObjectFromClassName to use this metaclass instead of TPersistenClass, and then the actual constructor will be called.
Also, TempObject is never freed. And instead of is, I would rather use InheritsFrom.
I did not test the following, but it should work:
function CreateObjectFromClassName(const AClassName: string; AOwner: TComponent): TPersistent;
var
PersistentClass: TPersistentclass;
begin
PersistentClass := FindClass(AClassName);
if PersistentClass.InheritsFrom(TComponent) then
Result := TComponentClass(PersistentClass).Create(AOwner)
else if PersistentClass.InheritsFrom(TCell) then
Result := TCellClass(PersistentClass).Create
else
Result := PersistentClass.Create;
end;
The compiler can't know for sure what value your variable of type TPersistentClass will hold at run time. So he assumes that it is exactly that: a TPersistentClass.
TPersistentClass is defined as a class of TPersistent. TPersistent has no virtual constructor, the compiler will therefore not include a call to dynamically look up the address of the constructor in the VMT of the actual class, but a 'hard-coded' call to the only matching constructor TPersistent has: the one it inherits from its base class TObject.
It might be a decision with reasons I don't know, but if you had chosen to define TCell as following
TCell = class(TComponent)
private
FAlignmentInCell: byte;
public
constructor Create(AOwner: TComponent); override;
published
property AlignmentInCell:byte read FAlignmentInCell write FAlignmentInCell;
end;
you wouldn't need TempObject and all the decision making in your CreateObjectFromClassName function (and the possible leaks as pointed out by others):
function CreateObjectFromClassName(AClassName:string): TComponent;
var
ComponentClass:TComponentClass;
begin
ComponentClass:=TComponentClass(FindClass(AClassName));
Result := ComponentClass.Create(nil);
end;
And make sure to manage the Results life-time as it has no Owner.
On the new side of writing classes and have a little problem which I have tried researching but still no answer.
I want to create one instance of a class which creates multiple subclasses which creates subclasses of their own. The idea is to use code like this in main program:
procedure TForm1.Button1Click(Sender: TObject);
var
Temp : Integer;
begin
MainClass := TMainClass.Create(Form1);
Temp := MainClass.SubClass1.SubSubClass1.SomeValue;
end;
The main class looks like this and is created in seperate file:
TMainClass = class(TObject)
private
FSubClass1 : TSubClass1;
public
ValueFromAnySubClass : Integer;
property SubClass1 : TSubClass1 read FSubClass1 write FSubClass1;
procedure SetSomeValueFromMainClass(Value : Integer);
end;
...
...
...
procedure TMainClass.SetSomeValueFromMainClass(Value : Integer);
begin
ValueFromAnySubClass := Value;
end;
The sub class also in seperate file:
TSubClass1 = class(TObject)
private
FSubSubClass1 : TSubSubClass1;
public
property SubSubClass1 : TSubSubClass1 read FSubSubClass1 write FSubSubClass1;
end;
And now for the sub sub class also in seperate file:
TSubSubClass1 = class(TObject)
private
SomeValue : Integer;
function GetSomeValue : Integer;
procedure SetSomeValue(Value : Integer);
public
property SomeValue : Integer read GetSomeValue write SetSomeValue;
end;
...
...
...
procedure TSubSubClass1.SetSomeValue(Value : Integer);
begin
SetSomeValueFromMainClass(Value); <<< Error Here <<<
end;
How do I get to use the functions and procedures from the main class in my sub classes?
You don't need a subclass to use a function from another class. Also your sample code has not used subclasses at all. A proper subclass automatically has access to all public and proteced functions of its ancestors.
As David has already pointed out, there are serious flaws in your intended deisgn.
Furthermore, based on your comment:
The classes all perform vastly different functions but need to write data to a piece of hardware at the end of the day. The data is read from the hardware and kept in memory to work with until its written back to the hardware component once all work is completed. The procedure in the main class takes care of writing real time data to the hardware whenever it is required by any of the subclasses.
to David's answer: you don't need subclasses at all.
All you need is a public method on your hardware class. And for each instance of your other classes to have a reference to the correct instance of your hardware class.
type
THardwareDevice = class(TObject)
public
procedure WriteData(...);
end;
TOtherClass1 = class(TObject)
private
FDevice: THardwareDevice;
public
constructor Create(ADevice: THardwareDevice);
procedure DoSomething;
end;
constructor TOtherClass1.Create(ADevice: THardwareDevice);
begin
FDevice := ADevice;
end;
procedure TOtherClass1.DoSomething;
begin
//Do stuff, and maybe you need to tell the hardware to write data
FDevice.WriteData(...);
end;
//Now given the above you can get two distinct object instances to interact
//as follows. The idea can be extended to more "other class" types and instances.
begin
FPrimaryDevice := THardwareDevice.Create(...);
FObject1 := TOtherClass1.Create(FPrimaryDevice);
FObject1.DoSomething;
//NOTE: This approach allows extreme flexibility because you can easily
// reference different instances (objects) of the same hardware class.
FBackupDevice := THardwareDevice.Create(...);
FObject2 := TOtherClass1.Create(FBackupDevice);
FObject2.DoSomething;
...
end;
The design looks really poor. You surely don't want to have all these classes knowing all about each other.
And any time you see a line of code with more than one . operator you should ask yourself if the code is in the right class. Usually that indicates that the line of code that has multiple uses of . should be in one of the classes further down the chain.
However, if you want to call a method, you need an instance. You write:
procedure TSubSubClass1.SetSomeValue(Value : Integer);
begin
SetSomeValueFromMainClass(Value);
end;
And naturally this does not compile. Because SetSomeValueFromMainClass is not a method of TSubSubClass1. Rather SetSomeValueFromMainClass is a method of TMainClass. So, to call that method, you need an instance of TMainClass.
Which suggests that, if you really must do this, that you need to supply to each instance of TSubSubClass1 an instance of TMainClass. You might supply that in the constructor and make a note of the reference.
Of course, when you do this you now find that your classes are all coupled together with each other. At which point one might wonder whether or not they should be merged.
I'm not saying that merging these classes is the right design. I would not like to make any confident statement as to what the right design is. Perhaps what you need is an interface that promises to implement the setter as a means to decouple things. All I am really confident in saying is that your current design is not the right design.
As far as I know Subclass word is usually using in inheritance concept but the code you wrote are some compound classes. As you may see the constructor of many classes in Delphi have an argument which named AOwner that may be TComponent or TObject or ...
If you define the constructors of your TSubclass1 and TSubSubClass1 like as follow and Change the Owner of classes that you defined as properties to Self in set functions you may access to your TMainClass by typecasting the Owner property.
I changed your code a little to just work as you want, but I suggest change your design.
TSubSubClass1 = class(TObject)
private
FOwner: TObject;
function GetSomeValue:Integer;
procedure SetSomeValue(const Value: Integer);
procedure SetOwner(const Value: TObject);
public
constructor Create(AOwner:TObject);reintroduce;
property Owner:TObject read FOwner write SetOwner;
property SomeValue : Integer read GetSomeValue write SetSomeValue;
end;
TSubClass1 = class(TObject)
private
FSubSubClass1: TSubSubClass1;
FOwner:TObject;
procedure SetSubSubClass1(const Value: TSubSubClass1);
procedure SetOwner(const Value: TObject);
public
constructor Create(AOwner:TObject);reintroduce;
property Owner:TObject read FOwner write SetOwner;
property SubSubClass1 : TSubSubClass1 read FSubSubClass1 write SetSubSubClass1;
end;
TMainClass = class(TObject)
private
FSubClass1: TSubClass1;
procedure SetSubClass1(const Value: TSubClass1);
public
ValueFromAnySubClass : Integer;
constructor Create;
property SubClass1 : TSubClass1 read FSubClass1 write SetSubClass1;
procedure SetSomeValueFromMainClass(Value : Integer);
end;
implementation
{ TSubSubClass1 }
constructor TSubSubClass1.Create(AOwner: TObject);
begin
Owner:=AOwner;
end;
function TSubSubClass1.GetSomeValue: Integer;
begin
Result:=TMainClass(TSubClass1(Self.Owner).Owner).ValueFromAnySubClass;
end;
procedure TSubSubClass1.SetOwner(const Value: TObject);
begin
FOwner := Value;
end;
procedure TSubSubClass1.SetSomeValue(const Value: Integer);
begin
TMainClass(TSubClass1(Self.Owner).Owner).SetSomeValueFromMainClass(Value);
end;
{ TSubClass1 }
constructor TSubClass1.Create(AOwner: TObject);
begin
Owner:=AOwner;
FSubSubClass1:=TSubSubClass1.Create(Self);
end;
procedure TSubClass1.SetOwner(const Value: TObject);
begin
FOwner := Value;
end;
procedure TSubClass1.SetSubSubClass1(const Value: TSubSubClass1);
begin
FSubSubClass1 := Value;
FSubSubClass1.Owner:=Self;
end;
{ TMainClass }
constructor TMainClass.Create;
begin
FSubClass1:=TSubClass1.Create(Self);
end;
procedure TMainClass.SetSomeValueFromMainClass(Value: Integer);
begin
ValueFromAnySubClass := Value;
end;
procedure TMainClass.SetSubClass1(const Value: TSubClass1);
begin
FSubClass1 := Value;
FSubClass1.Owner:=Self;
end;
you must put the proper filename in uses part of implementation.
I'm using a very large delphi third party library without source code, this library has several classes with abstract methods. I need to determine when an abtract method is implemented by a Descendant class in runtime to avoid the EAbstractError: Abstract Error and shows a custom message to the user or use another class instead.
for example in this code I want to check in runtime if the MyAbstractMethod is implemented.
type
TMyBaseClass = class
public
procedure MyAbstractMethod; virtual; abstract;
end;
TDescendantBase = class(TMyBaseClass)
public
end;
TChild = class(TDescendantBase)
public
procedure MyAbstractMethod; override;
end;
TChild2 = class(TDescendantBase)
end;
How I can determine if an abstract method is implemented in a Descendant class in runtime?
you can use the Rtti, the GetDeclaredMethods function get a list of all the methods that are declared in the reflected (current) type. So you can check if the method is present in the list returned by this function.
function MethodIsImplemented(const AClass:TClass;MethodName : string): Boolean;
var
m : TRttiMethod;
begin
Result := False;
for m in TRttiContext.Create.GetType(AClass.ClassInfo).GetDeclaredMethods do
begin
Result := CompareText(m.Name, MethodName)=0;
if Result then
break;
end;
end;
or you can compare the Parent.Name property of the TRttiMethod and check if match with the current class name.
function MethodIsImplemented(const AClass:TClass;MethodName : string): Boolean;
var
m : TRttiMethod;
begin
Result := False;
m:=TRttiContext.Create.GetType(AClass.ClassInfo).GetMethod(MethodName);
if m<>nil then
Result:=CompareText(AClass.ClassName,m.Parent.Name)=0;
end;
function ImplementsAbstractMethod(AObj: TMyBaseClass): Boolean;
type
TAbstractMethod = procedure of object;
var
BaseClass: TClass;
BaseImpl, Impl: TAbstractMethod;
begin
BaseClass := TMyBaseClass;
BaseImpl := TMyBaseClass(#BaseClass).MyAbstractMethod;
Impl := AObj.MyAbstractMethod;
Result := TMethod(Impl).Code <> TMethod(BaseImpl).Code;
end;
Look at the implementation of the 32-bit version of the TStream.Seek() method in the VCL source code (in Classes.pas). It performs a check to make sure the 64-bit version of Seek() has been overridden before calling it. It doesn't involve TRttiContext lookups to do that, just a simple loop through its Parent/Child VTable entries, similar to how Zoë's answer shows.
I'm making a framework (for internal use only) that has common code among 3 o 4 delphi database CRUD applications..
A common object of mi framework is a TContext,
TContext = class (IContext)
function DB: IDatabase;
function CurrentSettings: ISettings;
..
end;
that is passed to the initialization method of lots of other objects.. example (this will be application code):
TCustomer.Initialize(Context: IContext)
TProjectList.Initialize(Context: IContext)
..
Every application has some specific context functions (that only will be called from application code):
IApp1Context = interface (IContext)
procedure DoSomethingSpecificToApp1;
procedure DoOtherThing;
..
end;
So when I create a Context, Im creating a IApp1Context, and sending it to the initialization methods.. from the framework code everything is fine, the problem is that from the application code I'm constantly casting from IContext to IApp1Context to access the specific
App1 functions.. so all my application code looks like (and its a lot of code like this):
(FContext as IApp1Context).DoSomethingSpecificToApp1
(FContext as IApp1Context).DoOtherThing;
..
The thing is clearly usable, but doesnt reads well in my opinion. Maybe I'm exaggerating; is there is a clever design technique for this situation that I'm not aware of?
Use a temporary variable. Assign it once at the start of the method, and then use it where you need it.
var
AppContext: IApp1Context;
begin
AppContext := FContext as IApp1Context;
AppContext.DoSomethingSpecificToApp1;
AppContext.DoOtherThing;
end;
Or, since it looks like your IContext object is a field of an object, make your IApp1Context variable be a field of the same object. It could even replace the IContext field since IApp1Context already exposes everything the IContext does.
procedure TCustomer.Initialize(const Context: IContext);
begin
FContext := Context;
FAppContext := FContext as IApp1Context;
// ...
end;
What do you think of this possible solution using generics?
pro: no casting necesary
down: the generic invades almost every interface and class of the framework, making it more complicated..
// framework //
type
IContext = interface
function DB;
..
end;
TContext = class (TInterfaedObject, IContext)
function DB;
..
end;
IBusinessObj<T: IContext> = interface
procedure Initialize(AContext: T);
end;
TBusinessObj<T: IContext> = class (TInterfacedObject, IBusinessObj<T>)
protected
FContext: T;
public
procedure Initialize(Context: T); virtual;
end;
procedure TBusnessObj<T>.Initialize(Context: T);
begin
FContext := Context;
FContext.DB.Connect;
end;
// application //
type
IApp1Context = interface (IContext)
procedure DoSomethingElse;
..
end;
TApp1Context = class(TContext, IContext, IApp1Context)
function DB;
procedure DoSomethingElse;
end;
TCustomer = class(TBusinessObj<IApp1Context>)
public
procedure Initialize(AContext: IApp1Context); override;
end;
procedure Start;
var
C: IBusinessObj<IApp1Context>;
begin
C := TCustomer.Create;
C.Initializate(TApp1Context.Create);
..
end;
procedure TCustomer.Initialize(AContext: IApp1Context);
begin
inherited;
FContext.DoSomethingElse // here I can use FContext as a IApp1Context..
end;
Comment please, Thanks!
You could also give your class a private function AppContext defined like this:
function AppContext : IApp1Context;
begin
Result := FContext as IApp1Context;
end;
This avoids the additional variable declaration and keeps the cast local. From client code you can just write:
AppContext.DoSomethingSpecificToApp1;
AppContext.DoOtherThing
Can you have a class function that creates an instance of a class:
TMyClass = class(TSomeParent)
public
class function New(AValue : integer) : TMyClass;
end;
TDerivedClass = class(TMyClass)
public
function Beep;
end;
and then use it as follows
...
var
myList : TList<T>;
item : TDerivedClass;
begin
myList.Add(TDerivedClass.New(1))
myList.Add(TDerivedClass.New(3))
myList.Add(TDerivedClass.New(5))
for item in myList do
item.Beep; //times the count in the class function
...
And if so, what does that function code look like? Do you use TObject's NewInstance method and do you re-implement every-time for every derived class? Is it saver/better to use the Constructor?
The goal is to use this approach in a command pattern and load the command list with class types and a receiver e.g:
//FYI: document is an instance of TDocument
commandList.Execute(TOpenDocument(document));
commandList.Execute(TPasteFromClipboard(document));
//... lots of actions - some can undo
commandList.Execute(TPrintDocument(document));
commandList.Execute(TSaveDocument(document));
And the reason for this is that some commands will be specified via text/script and will need to be resolved at runtime.
What you're looking for is called the factory pattern. It can be done in Delphi; it's how the VCL deserializes forms, among other things. What you're missing is the registration/lookup part of the system. Here's the basic idea:
Somewhere, you set up a registration table. If you're on Delphi XE, you can implement this as a TDictionary<string, TMyClassType>, where TMyClassType is defined as class of TMyClass. This is important. You need a map between class names and class type references.
Put a virtual constructor on TMyClass. Everything that descends from it will use this constructor, or an override of it, when the factory pattern creates it.
When you create a new descendant class, have it call a method that will register itself with the registration table. This should happen at program startup, either in initialization or in a class constructor.
When you need to instantiate something from a script, do it like this:
class function TMyClass.New(clsname: string; [other params]): TMyClass;
begin
result := RegistrationTable[clsName].Create(other params);
end;
You use the registration table to get the class reference from the class name, and call the virtual constructor on the class reference to get the right type of object out of it.
Yes, it is technically possible to create an instance from a class method, simply call the actual constructor and then return the instance it creates, eg:
type
TMyClass = class(TSomeParent)
public
constructor Create(AValue : Integer); virtual;
class function New(AValue : integer) : TMyClass;
end;
TDerivedClass = class(TMyClass)
public
constructor Create(AValue : Integer); override;
function Beep;
end;
constructor TMyClass.Create(AValue : Integer);
begin
inherited Create;
...
end;
function TMyClass.New(AValue : integer) : TMyClass;
begin
Result := Create(AValue);
end;
constructor TDerivedClass.Create(AValue : Integer);
begin
inherited Create(AValue);
...
end;
var
myList : TList<TMyClass>;
item : TMyClass;
begin
myList.Add(TDerivedClass.New(1))
myList.Add(TDerivedClass.New(3))
myList.Add(TDerivedClass.New(5))
for item in myList do
TDerivedClass(item).Beep;
In which case, you are better off just using the constructor directly:
type
TMyClass = class(TSomeParent)
end;
TDerivedClass = class(TMyClass)
public
constructor Create(AValue : Integer);
function Beep;
end;
var
myList : TList<TDerivedClass>;
item : TDerivedClass;
begin
myList.Add(TDerivedClass.Create(1))
myList.Add(TDerivedClass.Create(3))
myList.Add(TDerivedClass.Create(5))
for item in myList do
item.Beep;
Can you have a class function that creates an instance of a class.
Is it saver/better to use the Constructor?
Constructor is a class function that creates an instance of class.
Just put:
constructor New(); virtual;
And you are good to go.
The virtual; part will let you call same New() constructor for all descendant classes.
Another option is to use RTTI. The code below runs as a normal method in my class as a way to get a new instance of the object with a subset of items, but as the items (along with the list object itself) are probably of descendent objects, creating an instance of the object in which the method is defined isn't good enough as it needs to be of the same type of the instance.
i.e.
TParentItem = Class
End;
TParentList = Class
Items : TList<TParentItem>;
Function GetSubRange(nStart,nEnd : Integer) : TParentList;
End;
TChildItem = Class(TParentItem)
end
TChildList = Class(TParentList)
end
List := TChildList.Create;
List.LoadData;
SubList := List.GetSubRange(1,3);
The implementation if GetSubRange would be something like...
Function TParentList.GetSubRange(nStart,nEnd : Integer) : TParentList;
var
aContext: TRttiContext;
aType: TRttiType;
aInsType : TRttiInstanceType;
sDebug : String;
begin
aContext := TRttiContext.Create;
aType := aContext.GetType(self.ClassType);
aInsType := aType.AsInstance;
Result := aInsType.GetMethod('Create').Invoke(aInsType.MetaclassType,[]).AsType<TParentList>;
sDebug := Result.ClassName; // Should be TChildList
// Add the items from the list that make up the subrange.
End;
I appreciate for some things it may be a bit OTT, but in the design above, it works and is another alternative, although I appreciate, its not a class method.
You should use a constructor (a special "kind" of class function). TObject.NewInstance is not a suitable option, unless you require special memory allocation.
And regarding the Execute routine of the command list: the action involved now depends on the type of the object. Imagine a document being able to open, print, paste and save at the same time (not a weird assumption), that would be difficult to implement in this structure. Instead, consider to add interfaces (IOpenDocument, IPasteFromClipboard, IPrintable, ISaveDocument) which indeed could all be actions of one document instance.