I want to instantiate classes based on a parameter. Both classes are derived from TSample so I define my code as:
var T: TSample;
then I do
T := TMySample.Create;
or
T := TYourSample.Create;
and calling T.Hello gives an "Abstract Error".
type TSample = class
public
procedure Hello; virtual; abstract;
end;
TMySample = class(TSample)
public
procedure Hello;
end;
TYourSample = class(TSample)
public
procedure Hello;
end;
...
procedure TForm1.Button1Click(Sender: TObject);
var T: TSample;
a: Integer;
begin
if a = 1 then T := TMySample.Create
else T := TYourSample.Create;
T.Hello; //Abstract Error here
T.Free;
end;
procedure TMySample.Hello;
begin
showmessage('My');
end;
procedure TYourSample.Hello;
begin
showmessage('Your');
end;
You forgot to declare the overridden methods as, well, overridden:
TMySample = class(TSample)
public
procedure Hello; override; // <--
end;
TYourSample = class(TSample)
public
procedure Hello; override; // <--
end;
Actually, the compiler warned you about this, but you didn't listen :)
[dcc32 Warning] Unit1.pas(25): W1010 Method 'Hello' hides virtual method of base type 'TSample'
[dcc32 Warning] Unit1.pas(30): W1010 Method 'Hello' hides virtual method of base type 'TSample'
Also, you probably already know this, but there are two issues with your sample code:
Since local variables of non-managed types are not initialized, the value of a is undefined.
You don't protect the TSample object, so you might leak resources. (In fact, in this case, you will due to the exception!)
Fixed:
a := 123;
if a = 1 then
T := TMySample.Create
else
T := TYourSample.Create;
try
T.Hello; //Abstract Error here
finally
T.Free;
end;
Related
I am new to Delphi Generic Classes. I don't get it of how to use the generic classes in the implementation code.
Here is the code:
Type TDataElement = class(TObject)
protected
Procedure SetName(sNewValue:String); virtual;
private
m_sName:String;
published
property sName:String read m_sName write SetName;
end;
Type TDataArray<T : TDataElement> = class(TObject)
public
function Find(dtElement:T):integer;
Procedure Add(dtElement:T);
private
m_vContainer : array of T;
protected
Function GetData(Index:integer):T; virtual;
Procedure SetData(Index:integer; NewValue:T); virtual;
public
property vData[Index: Integer]: T read GetData write SetData;
end;
implementation
function TDataArray<T>.Find(dtElement:T):integer;
var i:integer;
begin
Result:=-1;
for i := 0 to high(m_vContainer) do
if (m_vContainer[i] <> NIL)and(m_vContainer[i] = dtElement) then
begin
Result:=i;
exit;
end;
end;
.....
When I try to create instances of the Generic Classes like in the following code:
Method1)
var z:TDataArray<TDataElement>;
z:=TDataArray<TDataElement>.Create();
I get the following error:
E2010 Incompatible types: 'TDataElement' and 'class of TDataElement'
If I do this 2nd method I get another strange error:
Method 2)
type TDataElementClass = class of TDataElement;
var z:TDataArray<TDataElementClass>;
F2084 Internal Error : I8230
What I am doing wrong?
Entire source code in one file
System.SysUtils,Classes,
dtArray_unit in 'D:\VisionBot\Software\VisionBot\GUI\Units\dtArray_unit.pas';
Type TDataElement = class(TObject)
protected
Procedure SetName(sNewValue:String); virtual;
private
m_sName:String;
published
property sName:String read m_sName write SetName;
end;
Type TDataArray<T : TDataElement> = class(TObject)
public
function Find(dtElement:T):integer; overload;
Procedure Add(dtElement:T);
private
m_vContainer : array of T;
protected
Function GetData(Index:integer):T; virtual;
Procedure SetData(Index:integer; NewValue:T); virtual;
public
property vData[Index: Integer]: T read GetData write SetData;
end;
type
TDerivedDataElement = class(TDataElement)
end;
var
z2: TDataArray<TDerivedDataElement>;
//------------------------------------------------------------------------------
Procedure TDataElement.SetName(sNewValue:String);
begin
self.m_sName:=sNewValue;
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
function TDataArray<T>.Find(dtElement:T):integer;
var i:integer;
begin
Result:=-1;
for i := 0 to high(m_vContainer) do
if (m_vContainer[i] <> NIL)and(m_vContainer[i] = dtElement) then
begin
Result:=i;
exit;
end;
end;
//------------------------------------------------------------------------------
Function TDataArray<T>.GetData(Index:integer):T;
begin
Result:=NIL;
if Index < 0 then exit else
if Index > high(Index) then exit else
Result:=self.m_vContainer[Index];
end;
//------------------------------------------------------------------------------
Procedure TDataArray<T>.Add(dtElement:T);
begin
SetLength(self.m_vContainer,Length(m_vContainer)+1);
m_vContainer[High(m_vContainer)]:=T;
end;
//------------------------------------------------------------------------------
Procedure TDataArray<T>.SetData(Index:integer; NewValue:T);
begin
if Index < 0 then exit else
if Index > high(Index) then exit else
self.m_vContainer[Index]:=T;
end;
//------------------------------------------------------------------------------
begin
try
z2:= TDataArray<TDerivedDataElement>.Create();
readln;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
var
z: TDataArray<TDataElementClass>;
The problem is that TDataElementClass is not a class derived from TDataElement.
The following would be valid:
var
z: TDataArray<TDataElement>;
Or this:
type
TDerivedDataElement = class(TDataElement)
end;
var
z: TDataArray<TDerivedDataElement>;
In your code you have
type
TDataElementClass = class of TDataElement;
Now, TDataElementClass is a metaclass.
A variable of type TDataElement can hold an instance of the type TDataElement, or an instance of any class derived from TDataElement.
A variable of type TDataElementClass can hold a type, which must be TDataElement, or any class derived from TDataElement.
You claim in the question that using TDataArray<TDataElement> leads to a compiler error, but that is not true. Consider this compiling program:
type
TDataElement = class
end;
type
TDataArray<T: TDataElement> = class
public
function Find(dtElement: T): Integer;
private
m_vContainer: array of T;
end;
function TDataArray<T>.Find(dtElement: T): Integer;
begin
for Result := 0 to high(m_vContainer) do
if (m_vContainer[Result] <> nil) and (m_vContainer[Result] = dtElement) then
exit;
Result := -1;
end;
var
arr: TDataArray<TDataElement>;
begin
arr := TDataArray<TDataElement>.Create;
end.
In your edit you show this code:
Procedure TDataArray<T>.Add(dtElement:T);
begin
SetLength(self.m_vContainer,Length(m_vContainer)+1);
m_vContainer[High(m_vContainer)]:=T;
end;
The erroneous line is here:
m_vContainer[High(m_vContainer)]:=T;
This fails because T is a type rather than an instance. I think you mean:
m_vContainer[High(m_vContainer)]:=dtElement;
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;
i had another bug in my app caused by careless usage of Delphi interfaces. When i pass an interface to a procedure which ignores that argument, the instance is never freed. See the following simple example:
ITest = interface
procedure Test;
end;
Tester = class(TInterfacedObject, ITest)
public
procedure Test;
end;
Base = class
public
procedure UseTestOrNot(test : ITest); virtual; abstract;
end;
A = class(Base)
public
procedure UseTestOrNot(test : ITest); override;
end;
B = class(Base)
public
procedure UseTestOrNot(test : ITest); override;
end;
{ A }
procedure A.UseTestOrNot(test: ITest);
begin
test.Test();
end;
{ B }
procedure B.UseTestOrNot(test: ITest);
begin
WriteLn('No test here');
end;
// -------- Test ---------------------------------------
var
list : TObjectList<Base>;
x : Base;
t : ITest;
begin
ReportMemoryLeaksOnShutdown := true;
list := TObjectList<Base>.Create;
list.Add(A.Create);
list.Add(B.Create);
// 1 x Tester leak for each B in list:
for x in list do
x.UseTestOrNot(Tester.Create);
// this is ok
for x in list do
begin
t := Tester.Create;
x.UseTestOrNot(t);
end;
list.Free;
end.
Can you please explain what goes wrong with the reference counter?
Can you give any best practice/ guideline (like "Never create an interfaced instance inside a function call [if you don't know what happens inside]).
The best solution i can think of for this example is to write a template method in class Base that saves the passed test instance and calls an abstract DoUseTestOrNot method.
EDIT
Delphi 2010
It is a different manifestation of the bugs here.
I will add this to the QC report.
This does not reproduce in Delphi XE update 1 any more.
--jeroen
Add a guid to you ITest declaration
ITest = interface
['{DB6637F9-FAD3-4765-9EC1-0A374AAC7469}']
procedure Test;
end;
Change the loop to this
for x in list do
x.UseTestOrNot(Tester.Create as ITest);
The GUID is neccesary to be able to use as
Test.Create as ITest makes the compiler to add the release where the created object goes out of scope.
Here is my code example:
type
TMyBaseClass = class
public
procedure SomeProc; virtual;
end;
TMyChildClass = class(TMyBaseClass)
public
procedure SomeProc; override;
end;
var
SomeDelegate: procedure of object;
procedure TMyBaseClass.SomeProc;
begin
ShowMessage('Base proc');
end;
procedure TMyChildClass.SomeProc;
begin
ShowMessage('Child proc');
// here i want to get a pointer to TMyBaseClass.SomeProc (NOT IN THIS CLASS!):
SomeDelegate := SomeProc;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
with TMyChildClass.Create do
try
// there will be "Child proc" message:
SomeProc;
finally
Free;
end;
// there i want to get "Base proc" message, but i get "Child proc" again
// (but it is destroyed anyway, how coud it be?):
SomeDelegate;
end;
The one way I know is:
procedure TMyChildClass.BaseSomeProc;
begin
inherited SomeProc;
end;
procedure TMyChildClass.SomeProc;
begin
ShowMessage('Child proc');
SomeDelegate := BaseSomeProc;
end;
The 2nd is to change SomeProc declaration from override to reintroduce:
TMyChildClass = class(TMyBaseClass)
public
procedure SomeProc; reintroduce;
end;
and then cast self as TMyBaseClass (do not use as cast):
SomeDelegate := TMyBaseClass(self).SomeProc;
Also note that your code will give Access Violation because you call SomeDelegate on already freed object.
Adding a type declaration and some typecasting works but comes with some notes of warning.
As you've mentioned it yourself, the call to somedelegate after the instance has been freed doesn't AV. This is because your SomeProc method doesn't use any instance variables, all it does is calling ShowMessage.
Should you add any instance variables to the call, you even might still get away with it if the memory has not been reassigned. It would be an AV waiting to happen.
Bottom line:
don't call methods off destroyed objects.
setting a global variable from within an instance of a class that survives the lifetime of the class is not considered good design.
in a ideal design, there should be no need for a child class to revert a call anyhow to the ancestor's method, other than by calling inherited.
Code changes
...
type
TSomeDelegate = procedure of object;
var
SomeDelegate: TSomeDelegate;
...
procedure TMyChildClass.SomeProc;
var
method: TMethod;
begin
ShowMessage('Child proc');
// here i want to get a pointer to TMyBaseClass.SomeProc (NOT IN THIS CLASS!):
method.Code := #TMyBaseClass.SomeProc;
method.Data := Self;
SomeDelegate := TSomeDelegate(method);
end;
Is it possible to pass interface's method as parameters?
I'm trying something like this:
interface
type
TMoveProc = procedure of object;
// also tested with TMoveProc = procedure;
// procedure of interface is not working ;)
ISomeInterface = interface
procedure Pred;
procedure Next;
end;
TSomeObject = class(TObject)
public
procedure Move(MoveProc: TMoveProc);
end;
implementation
procedure TSomeObject.Move(MoveProc: TMoveProc);
begin
while True do
begin
// Some common code that works for both procedures
MoveProc;
// More code...
end;
end;
procedure Usage;
var
o: TSomeObject;
i: ISomeInterface;
begin
o := TSomeObject.Create;
i := GetSomeInterface;
o.Move(i.Next);
// somewhere else: o.Move(i.Prev);
// tested with o.Move(#i.Next), ##... with no luck
o.Free;
end;
But it is not working because:
E2010 Incompatible types: 'TMoveProc' and 'procedure, untyped pointer or untyped parameter'
Of course I can do private method for each call, but that is ugly. Is there any better way?
Delphi 2006
Edit:
I know that I can pass whole interface, but then I have to specify which function use. I don't want two exactly same procedures with one different call.
I can use second parameter, but that is ugly too.
type
SomeInterfaceMethod = (siPred, siNext)
procedure Move(SomeInt: ISomeInterface; Direction: SomeInterfaceMethod)
begin
case Direction of:
siPred: SomeInt.Pred;
siNext: SomeInt.Next
end;
end;
Thanks all for help and ideas. Clean solution (for my Delphi 2006) is Diego's Visitor. Now I'm using simple ("ugly") wrapper (my own, same solution by TOndrej and Aikislave).
But true answer is "there is no (direct) way to pass interface's methods as parameters without some kind of provider.
If you were using Delphi 2009, you could do this with an anonymous method:
TSomeObject = class(TObject)
public
procedure Move(MoveProc: TProc);
end;
procedure Usage;
var
o: TSomeObject;
i: ISomeInterface;
begin
o := TSomeObject.Create;
i := GetSomeInterface;
o.Move(procedure() begin i.Next end);
The problem with trying to pass a reference to just the interface method is that you are not passing a reference to the interface itself, so the interface cannot be reference counted. But anonymous methods are themselves reference counted, so the interface reference inside the anonymous method here can be reference counted as well. That is why this method works.
I don't know the exact reason why you need to do that, but, personally, I think it would be better to pass the whole "Mover" object instead of one of its methods. I used this approach in the past, it's called "Visitor" pattern.
tiOPF, an object persistence framework, uses it extensively and gives you a good example of how it works: The Visitor Pattern and the tiOPF.
It's relatively long, but it proved very useful to me, even when I didn't use tiOPF. Note step 3 in the document, titled "Step #3. Instead of passing a method pointer, we will pass an object".
DiGi, to answer your comment: If you use Visitor pattern, then you don't have an interface implementing multiple methods, but just one (Execute). Then you'd have a class for each action, like TPred, TNext, TSomething, and you pass an instance of such classes to the object to be processed. In such way, you don't have to know what to call, you just call "Visitor.Execute", and it will do the job.
Here you can find a basic example:
interface
type
TVisited = class;
TVisitor = class
procedure Execute(Visited: TVisited); virtual; abstract;
end;
TNext = class(TVisitor)
procedure Execute (Visited: TVisited); override;
end;
TPred = class(TVisitor)
procedure Execute (Visited: TVisited); override;
end;
TVisited = class(TPersistent)
public
procedure Iterate(pVisitor: TVisitor); virtual;
end;
implementation
procedure TVisited.Iterate(pVisitor: TVisitor);
begin
pVisitor.Execute(self);
end;
procedure TNext.Execute(Visited: TVisited);
begin
// Implement action "NEXT"
end;
procedure TPred.Execute(Visited: TVisited);
begin
// Implement action "PRED"
end;
procedure Usage;
var
Visited: TVisited;
Visitor: TVisitor;
begin
Visited := TVisited.Create;
Visitor := TNext.Create;
Visited.Iterate(Visitor);
Visited.Free;
end;
Although the wrapper class solution works, I think that's an overkill. It's too much code, and you have to manually manage the lifetime of the new object.
Perhaps a simpler solution would be to create methods in the interface that returns TMoveProc
ISomeInterface = interface
...
function GetPredMeth: TMoveProc;
function GetNextMeth: TMoveProc;
...
end;
The class that implements the interface can provide the procedure of object and it will be accessible through the interface.
TImplementation = class(TInterfaceObject, ISomeInterface)
procedure Pred;
procedure Next;
function GetPredMeth: TMoveProc;
function GetNextMeth: TMoveProc;
end;
...
function TImplementation.GetPredMeth: TMoveProc;
begin
Result := Self.Pred;
end;
function TImplementation.GetNextMeth: TMoveProc;
begin
Result := Self.Next;
end;
How about this:
type
TMoveProc = procedure(const SomeIntf: ISomeInterface);
TSomeObject = class
public
procedure Move(const SomeIntf: ISomeInterface; MoveProc: TMoveProc);
end;
procedure TSomeObject.Move(const SomeIntf: ISomeInterface; MoveProc: TMoveProc);
begin
MoveProc(SomeIntf);
end;
procedure MoveProcNext(const SomeIntf: ISomeInterface);
begin
SomeIntf.Next;
end;
procedure MoveProcPred(const SomeIntf: ISomeInterface);
begin
SomeIntf.Pred;
end;
procedure Usage;
var
SomeObj: TSomeObject;
SomeIntf: ISomeInterface;
begin
SomeIntf := GetSomeInterface;
SomeObj := TSomeObject.Create;
try
SomeObj.Move(SomeIntf, MoveProcNext);
SomeObj.Move(SomeIntf, MoveProcPred);
finally
SomeObj.Free;
end;
end;
Here is another solution that is working in Delphi 20006. It is similar to the idea of #Rafael, but using interfaces:
interface
type
ISomeInterface = interface
//...
end;
IMoveProc = interface
procedure Move;
end;
IMoveProcPred = interface(IMoveProc)
['{4A9A14DD-ED01-4903-B625-67C36692E158}']
end;
IMoveProcNext = interface(IMoveProc)
['{D9FDDFF9-E74E-4F33-9CB7-401C51E7FF1F}']
end;
TSomeObject = class(TObject)
public
procedure Move(MoveProc: IMoveProc);
end;
TImplementation = class(TInterfacedObject,
ISomeInterface, IMoveProcNext, IMoveProcPred)
procedure IMoveProcNext.Move = Next;
procedure IMoveProcPred.Move = Pred;
procedure Pred;
procedure Next;
end;
implementation
procedure TSomeObject.Move(MoveProc: IMoveProc);
begin
while True do
begin
// Some common code that works for both procedures
MoveProc.Move;
// More code...
end;
end;
procedure Usage;
var
o: TSomeObject;
i: ISomeInterface;
begin
o := TSomeObject.Create;
i := TImplementation.Create;
o.Move(i as IMoveProcPred);
// somewhere else: o.Move(i as IMoveProcNext);
o.Free;
end;
You can't. Because of the scoping of Interfaces it would be possible (perhaps?) for the Interface to be released before you called the .Next function. If you want to do this you should pass the whole interface to your method rather than just a method.
Edited...
Sorry, this next bit, specifically the "Of Interface" bit was meant in jest.
Also, and I could be wrong here, i.Next is not a method Of Object, as per your type def, it would be a method Of Interface!
Redefine your function
TSomeObject = class(TObject)
public
procedure Move(Const AMoveIntf: ISomeInterface);
end;
Procedure TSomeObject.Move(Const AMoveIntf : ISomeInterface);
Begin
....;
AMoveIntf.Next;
end;
O.Move(I);
Hope this helps.
You currently have TMoveProc defined as
TMoveProc = procedure of object;
Try taking out the "of object" which implies a hidden "this" pointer as first parameter.
TMoveProc = procedure;
That should allow a normal procedure to be called.