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.
Related
I am using generics to define a list of objects that themselves hold generic lists. I have written a method for retrieving the aggregate of each of these lists using specific methods that basically do the same thing. Below is the structure:
unit Unit1;
interface
uses
System.Generics.Collections;
type
TListType=(ltSType,ltFType);
TMyList<T> = class(TList<T>)
{Do some stuff in here to help load lists etc}
end;
TListObject=class(TObject)
private
FSList:TMyList<string>;
FIList:TMyList<integer>;
function GetSList: TMyList<string>;
function GetIList: TMyList<integer>;
public
property MySList:TMyList<string> read GetSList;
property MyIList:TMyList<integer> read GetIList;
constructor create;
end;
TListOfObject<T:TListObject> = class(TObjectList<T>)
public
Function AggrSList:TMyList<string>;
Function AggrIList:TMyList<integer>;
end;
implementation
{ TListObject }
constructor TListObject.create;
begin
FSList:=TMyList<string>.create;
FIList:=TMyList<integer>.create;
end;
function TListObject.GetIList: TMyList<integer>;
begin
result:=FIlist;
end;
function TListObject.GetSList: TMyList<string>;
begin
result:=FSList;
end;
{ TListOfObject<T> }
function TListOfObject<T>.AggrIList: TMyList<integer>;
var
i,j:integer;
begin
result:=TMyList<integer>.create;
for I := 0 to count-1 do
for j := 0 to items[i].MyIList.Count-1 do
result.Add(items[i].MyIList[j]);
end;
function TListOfObject<T>.AggrSList: TMyList<string>;
var
i,j:integer;
begin
result:=TMyList<string>.create;
for I := 0 to count-1 do
for j := 0 to items[i].MySList.Count-1 do
result.Add(items[i].MySList[j]);
end;
end.
I am still fairly new to generics but feel that the aggregate methods AggrIList and AggrSlist could be written using generics that uses a single method to extract the data then is cast at the result.
Is this possible and how would I approach this? I plan to do some more advanced functions that would benefit from this approach as well.
You can use (pseudocode):
TNestedList<T> = class(TList<TList<T>>)
function GetAggregateList : TList<T>;
end;
function TNestedList<T>.GetAggregateList : TList<T>;
var
List : TList<T>;
Item : T;
begin
Result := TList<T>.Create;
for List in Self do
for Item in List do
Result.Add(Item);
end;
No need to implement GetAggregateList for specific types - that's what you use generics for.
Also note that it might be better to either call your method CreateAggregateList (to make clear that the caller is responsible for destroying the created list) or to pass in an already created list instance into a procedure:
procedure GetAggregateList(List : TList<T>);
...which leaves list ownership completely to the caller and is quite a common pattern in Delphi.
all,
In Delphi, I created a simple class called T_Test (see below).
T_Test = class(TObject)
private
F_Int : Integer;
public
constructor Create(inInt: Integer);
destructor Destroy; override;
property Int: Integer read F_Int write F_Int;
function showInt : String;
end;
constructor T_Test.Create(inInt: Integer);
begin
F_Int := inInt;
end;
destructor T_Test.Destroy;
begin
self.Free;
end;
function T_Test.showInt : String;
var outputLine : String;
begin
result := IntToStr(Int);
outputLine := result;
Form1.Memo1.Lines.Add(outputLine);
end;
Then I have a procedure in which I want to make a TList of T_Test object and call the
showInt method function on them.
I tried like this :
procedure testTlist;
var
a, b: T_Test;
i : Integer;
begin
a := T_Test.Create(5);
b := T_Test.Create(10);
listTest := TList.Create;
listTest.Add(a);
listTest.Add(b);
listTest[i].showInt;
end;
But I keep getting an an that says I have to use a Record, Object or Class Type on the
call of 'listTest[i].showInt'
Does anyone know how to call this method ?
Cast the listTest[i] pointer back to T_Test and then call its method:
T_Test(listTest[i]).showInt;
Alternatively, if available, use a templated TObjectList class to store T_Test instances directly.
Martin's answer is correct. But it's worth noting that if you might be adding different classes to your list, a more robust fragment of code would be ...
var pMmember: pointer;
pMember := listTest[i];
if TObject( pMember) is T_Test then
T_Test( pMember).ShowInt;
Martin's point about TObjectList is quiet correct. Another option to consider would be TList<T_Test>. David's comment about the error in your destructor is correct too.
I note that you did not initialise the value of i. So the fragment above is pretending you did. If you also wanted to check that the index variable was at a valid value, and not call ShowInt if it was invalid, then you could do something like this...
if (i >= 0) and (i < listTest.Count) and (TObject(listTest[i]) is T_Test) then
T_Test(listTest[i]).ShowInt;
The above code fragment relies on short-circuit boolean evaluation.
I have two classes: one base class an one derived class
The base class defines a virtual method with a parameter:
function ToName(MsgIfNil:string=''); virtual;
The derived class redefines the method:
function ToName(MsgIfNil:string=''); reintroduce;
The implementation of both methods is similar to this code:
function TBaseClass.ToName(MsgIfNil:string)
begin
if (Self=nil) then
Result := MsgIfNil
else
Result := Self.SomeProperty;
end;
The issue is that:
1) If I do not reintroduce the method in the derived class, but use the regular override keyword, any call to this method triggers an access violation
2) When I call the method from an object being nil, and the presumed class of the objet is TBaseObject, it crashes (AV) instead of calling the base virtual method
If no parameter is defined in the method, the right method is called, without any AV. It works well even if the method in the derived class is overriden.
Note that the above solution works well with objects of any class derived from TBaseClass
How can I define a virtual method that can be called with Self=nil, can be virtual and use parameters?
I certainly must enhance my understanding of internal virtual method call plumbering...
Note: Calling on a nil object is legitimate in my use cases. It is not used to hide exceptions, but to report on non linked objects.
Example: myEdit.Text := APerson.Manager.ToName('No manager defined');
Thanks for any advise on a proper solution
Using Delphi 2010 with upd5
Edit: Adding a more complete example of code that triggers an AV
TBaseClass = class(TObject)
private
FMyName: string;
public
property MyName: string read FMyName;
function ToName(MsgIfNil:string=''):string; virtual;
end;
TDerivedClass = class(TBaseClass)
private
FSpecialName: string;
public
property SpecialName:string read FSpecialName;
function ToName(MsgIfNil:string=''):string; reintroduce;
end;
TBaseClass.ToName(MsgIfNil:string):string;
begin
if (Self=nil) then
Result := MsgIfNil
else
Result := MyName;
end;
TDerivedClass.ToName(MsgIfNil:string):string;
begin
if (Self=nil) then
Result := MsgIfNil
else
Result := SpecialName;
end;
// Now a sample program
var
aPerson: TBaseClass;
aSpecialist: TDerivedClass;
begin
aPerson := TBaseClass.Create;
aPerson.MyName := 'a person';
aSpecialist := TDerivedClass.Create;
aSpecialist.SpecialName := 'a specialist';
aSpecialist := nil; // For example sake, never do this in my use case :)
// This works here,
// but triggers an AV if ToName is marked as override instead of reintroduce
ShowMessage('Name of the specialist: '+aSpecialist.ToName('No specialist!'));
aPerson := nil;
// This triggers an AV, TBaseClass.ToName is never called
ShowMessage('Name of the person: '+aPerson.ToName('No person!'));
end;
The above code may not compile, this is only intended to be a more complete example
Takeway
I now understand that VMT is linked to the object reference and, regardless of the object class, calling a virtual method on a nil object is not possible (the object will not even look at its declared type to get the matching address of the ToName method)
I accepted hvd's solution because it is really effective for methods that must check vs nil (only one base method to add).
Thanks for all answers,
Calling a virtual method on nil doesn't make sense: virtual means "check the class type to see which method to call". There is no class type, so there is no method to call.
What you can do is create a nonvirtual method that calls a virtual method:
// TBase
public:
function ToName(MsgIfNil: string = ''): string;
protected:
function ToNameImpl: string; virtual;
// TDerived
protected:
function ToNameImpl: string; override;
function TBase.ToName(MsgIfNil: string): string;
begin
if (Self=nil) then
Result := MsgIfNil
else
Result := ToNameImpl;
end;
function TBase.ToNameImpl: string;
begin
Result := MyName;
end;
function TDerived.ToNameImpl: string;
begin
Result := MyDerivedName;
end;
This ensures that ToNameImpl, the virtual method, is only called when Self is not nil.
Edit: By the way, this is exactly what the nonvirtual TObject.Free does to call the virtual TObject.Destroy.
Theoretically You can call a method of a nil object. But this practice is very unwanted and dangerous. Avoid it. Rethink your logic. Take a look at class methods.
They will work more like a "static" methods with a lot of limits. You can't acces any properties nor methods that references to properies including Self, nor inherited; because object simply not exists.
Object must be valid before any method call, propery access.
If your function return an object instance that can be nil or in some circumstances your object can be nil, you need to check it before any method call or property access:
O := MyFactory.GetObject;
if Assigned(O) then O.MyMethod;
How can I define a virtual method that can be called with Self=nil, can be virtual and use parameters?
That can't be done in delphi, because you will need a VMT for a virtual method call. And Nil-objects don't have VMT.
Calling on a nil object is legitimate in my use cases.
You will have to rethink your logic. For example you can create some sort of "Empty" object. In this case your APerson.Manager will return this special object, which is an ancestor of TBaseClass with special behaviour. Some sample code:
TManager = class
//...
function GetSalary: integer; virtual;
procedure SetSalary(ASalary: integer) virtual;
end;
TEmptyManager = class(TManager)
//...
function GetSalary: integer; override;
procedure SetSalary(ASalary: integer) override;
end;
//...
function TManager.GetSalary: integer;
begin
//Some calculations here
end;
procedure TManager.SetSalary(ASalary: integer);
begin
//Some work here
end;
function TEmptyManager.GetSalary: integer;
begin
Result := 0;
end;
procedure TEmptyManager.SetSalary(ASalary: integer) override;
begin
//Some sort of safety belt
raise EException.Create('You can''t work with empty manager');
end;
var
EManager: TEmptyManager = Nil;
//Since we won't work with empty manager, one instance will be enough
function EmptyManager: TManager;
begin
if not Assigned(EManager) then
EManager := TEmptyManager.Create;
Result := EManager;
end;
//...
function TPerson.GetManager: TManager;
begin
if SomeCondition then
Result := FManager
else
Result := EmptyManager;
end;
First, a little explanation about my situation:
I have a sample interface which is implemented by different classes, and these classes might not always have a shared ancestor:
IMyInterface = interface
['{1BD8F7E3-2C8B-4138-841B-28686708DA4D}']
procedure DoSomething;
end;
TMyImpl = class(TInterfacedPersistent, IMyInterface)
procedure DoSomething;
end;
TMyImp2 = class(TInterfacedObject, IMyInterface)
procedure DoSomething;
end;
I also have a factory method which is supposed to create an instance of an object which implements my interface. My factory method receives the class name as its parameter:
function GetImplementation(const AClassName: string): IMyInterface;
I tried two approaches to implement this factory method, the first one was using extended RTTI:
var
ctx : TRttiContext;
t : TRttiInstanceType;
begin
t := ctx.FindType(AClassName).AsInstance;
if Assigned(t) then
Result := t.GetMethod('Create').Invoke(t.MetaclassType, []).AsInterface as IMyInterface;
end;
In this approach I am calling the default constructor which is fine in my scenario. The problem with this is, at runtime, I get an error telling me the object does not support IMyInterface. What's more, the created object is not assigned to an interface variable; therefore, it will be leaked. I also tried returning the value using TValue.AsType method, but it gives me Access Violation:
function GetImplementation(const AClassName: string): IMyInterface;
var
ctx : TRttiContext;
rt : TRttiInstanceType;
V : TValue;
begin
rt := ctx.FindType(AClassName).AsInstance;
if Assigned(rt) then
begin
V := rt.GetMethod('Create').Invoke(rt.MetaclassType, []);
Result := V.AsType<IMyInterface>;
end;
end;
.
The second approach I tried was using a generic dictionary to hold pairs of , and provide registration, unregistration methods:
TRepository = class
private
FDictionary : TDictionary<string, TClass>;
public
constructor Create;
destructor Destroy; override;
function GetImplementation(const AClassName: string): IMyInterface;
procedure RegisterClass(AClass: TClass);
procedure UnregisterClass(AClass: TClass);
end;
Here I implemented GetImplementation method as this:
function TRepository.GetImplementation(const AClassName: string): IMyInterface;
var
Obj : TObject;
begin
if FDictionary.ContainsKey(AClassName) then
begin
Obj := FDictionary[AClassName].Create;
Obj.GetInterface(IMyInterface, Result);
end;
end;
This works fine, and I can call DoSomething method using the returned value of GetImplementation, but it still has the memory-leak problem; Obj which is created here is not assigned to any interface variable; therefore, it is not reference-counted, and is leaked.
.
Now, my actual question:
So my question is, how can I safely create an instance of a class which implements my interface at runtime? I saw Delphi Spring Framework, and it provides such functionality in its Spring.Services unit, but it has its own reflection routines and lifetime management models. I am looking for a lightweight solution, not a whole 3rd-party framework to do this for me.
Regards
The first case using the RTTI give you a access violation because the TRttiContext.FindType(AClassName) cannot find the Rtti info for the classes which are not registered or used explicity in the app.
So you can change your code to
function GetImplementation(AClass: TClass): IMyInterface;
var
ctx : TRttiContext;
t : TRttiInstanceType;
begin
t := ctx.GetType(AClass).AsInstance;
if Assigned(t) then
Result := t.GetMethod('Create').Invoke(t.MetaclassType, []).AsInterface As IMyInterface;
end;
and call in this way
AClass:=GetImplementation(TMyImp2);
Now if you want to use the Class name to invoke the class, using a list (like your TRepository class) to register the classes is a valid aproach. about the memory leak i'm pretty sure which is caused because the TMyImpl class is derived from the TInterfacedPersistent which not implement reference counting directly like the TInterfacedObject.
This implementation of the the TRepository must works ok.
constructor TRepository.Create;
begin
FDictionary:=TDictionary<string,TClass>.Create;
end;
destructor TRepository.Destroy;
begin
FDictionary.Free;
inherited;
end;
function TRepository.GetImplementation(const AClassName: string): IMyInterface;
var
Obj : TObject;
begin
if FDictionary.ContainsKey(AClassName) then
begin
Obj := FDictionary[AClassName].Create;
Obj.GetInterface(IMyInterface, Result);
end;
end;
{
or using the RTTI
var
ctx : TRttiContext;
t : TRttiInstanceType;
begin
t := ctx.GetType(FDictionary[AClassName]).AsInstance;
if Assigned(t) then
Result := t.GetMethod('Create').Invoke(t.MetaclassType, []).AsInterface As IMyInterface;
end;
}
procedure TRepository.RegisterClass(AClass: TClass);
begin
FDictionary.Add(AClass.ClassName,AClass);
end;
procedure TRepository.UnregisterClass(AClass: TClass);
begin
FDictionary.Remove(AClass.ClassName);
end;
I think I would opt for the second option, mainly because I prefer to avoid RTTI unless it is the only possible solution to a problem.
But in both your proposed options you state that
the object which is created here is not assigned to any interface variable
That's simply not true. In both cases you assign to Result which has type IMyInterface. If you have a memory leak, it is caused by some other code, not by this code.
And #RRUZ has found the cause of the leak – namely using TInterfacedPersistent which does not implement reference counted lifetime management. Your code won't leak for TInterfacedObject.
For what it is worth, I would assign directly to the interface variable rather than via an object reference, but that is just a matter of stylistic preference.
if FDictionary.TryGetValue(AClassName, MyClass) then
Result := MyClass.Create as IMyInterface;
You can do it using extended RTTI and TObject's GetInterface method:
function GetImplementation(const AClassName: string): IMyInterface;
var
ctx: TRttiContext;
t : TRttiInstanceType;
obj: TObject;
begin
Result := nil;
t := ctx.FindType(AClassName).AsInstance;
if Assigned(t) then begin
obj := t.GetMethod('Create').Invoke(t.MetaclassType, []).AsObject;
obj.GetInterface(IMyInterface, Result)
end;
end;
It won't work if the object overrides QueryInterface to do custom processing, but both TInterfacedPersistent and TInterfacedObject rely on GetInterface.
Using Delphi 2010, let's say I've got a class declared like this:
TMyList = TList<TMyObject>
For this list Delphi kindly provides us with an enumerator, so we can write this:
var L:TMyList;
E:TMyObject;
begin
for E in L do ;
end;
The trouble is, I'd like to write this:
var L:TMyList;
E:TMyObject;
begin
for E in L.GetEnumerator('123') do ;
end;
That is, I want the ability to provide multiple enumerators for the same list, using some criteria. Unfortunately the implementation of for X in Z requires the presence of a function Z.GetEnumerator, with no parameters, that returns the given enumerator! To circumvent this problem I'm defining an interface that implements the "GetEnumerator" function, then I implement a class that implements the interface and finally I write a function on TMyList that returns the interface! And I'm returning an interface because I don't want to be bothered with manually freeing the very simple class... Any way, this requires a LOT of typing. Here's how this would look like:
TMyList = class(TList<TMyObject>)
protected
// Simple enumerator; Gets access to the "root" list
TSimpleEnumerator = class
protected
public
constructor Create(aList:TList<TMyObject>; FilterValue:Integer);
function MoveNext:Boolean; // This is where filtering happens
property Current:TTipElement;
end;
// Interface that will create the TSimpleEnumerator. Want this
// to be an interface so it will free itself.
ISimpleEnumeratorFactory = interface
function GetEnumerator:TSimpleEnumerator;
end;
// Class that implements the ISimpleEnumeratorFactory
TSimpleEnumeratorFactory = class(TInterfacedObject, ISimpleEnumeratorFactory)
function GetEnumerator:TSimpleEnumerator;
end;
public
function FilteredEnum(X:Integer):ISimpleEnumeratorFactory;
end;
Using this I can finally write:
var L:TMyList;
E:TMyObject;
begin
for E in L.FilteredEnum(7) do ;
end;
Do you know a better way of doing this? Maybe Delphi does support a way of calling GetEnumerator with a parameter directly?
Later Edit:
I decided to use Robert Love's idea of implementing the enumerator using anonymous methods and using gabr's "record" factory to save yet an other class. This allows me to create a brand new enumerator, complete with code, using just a few lines of code in a function, no new class declaration required.
Here's how my generic enumerator is declared, in a library unit:
TEnumGenericMoveNext<T> = reference to function: Boolean;
TEnumGenericCurrent<T> = reference to function: T;
TEnumGenericAnonim<T> = class
protected
FEnumGenericMoveNext:TEnumGenericMoveNext<T>;
FEnumGenericCurrent:TEnumGenericCurrent<T>;
function GetCurrent:T;
public
constructor Create(EnumGenericMoveNext:TEnumGenericMoveNext<T>; EnumGenericCurrent:TEnumGenericCurrent<T>);
function MoveNext:Boolean;
property Current:T read GetCurrent;
end;
TGenericAnonEnumFactory<T> = record
public
FEnumGenericMoveNext:TEnumGenericMoveNext<T>;
FEnumGenericCurrent:TEnumGenericCurrent<T>;
constructor Create(EnumGenericMoveNext:TEnumGenericMoveNext<T>; EnumGenericCurrent:TEnumGenericCurrent<T>);
function GetEnumerator:TEnumGenericAnonim<T>;
end;
And here's a way to use it. On any class I can add a function like this (and I'm intentionally creating an enumerator that doesn't use a List<T> to show the power of this concept):
type Form1 = class(TForm)
protected
function Numbers(From, To:Integer):TGenericAnonEnumFactory<Integer>;
end;
// This is all that's needed to implement an enumerator!
function Form1.Numbers(From, To:Integer):TGenericAnonEnumFactory<Integer>;
var Current:Integer;
begin
Current := From - 1;
Result := TGenericAnonEnumFactory<Integer>.Create(
// This is the MoveNext implementation
function :Boolean
begin
Inc(Current);
Result := Current <= To;
end
,
// This is the GetCurrent implementation
function :Integer
begin
Result := Current;
end
);
end;
And here's how I'd use this new enumerator:
procedure Form1.Button1Click(Sender: TObject);
var N:Integer;
begin
for N in Numbers(3,10) do
Memo1.Lines.Add(IntToStr(N));
end;
See DeHL ( http://code.google.com/p/delphilhlplib/ ). You can write code that looks like this:
for E in List.Where(...).Distinct.Reversed.Take(10).Select(...)... etc.
Just like you can do in .NET (no syntax linq of course).
You approach is fine. I don't know of any better way.
Enumerator factory can also be implemented as a record instead of an interface.
Maybe you'll get some ideas here.
Delphi For in loop support requires on of the following: (From the Docs)
Primitive types that the compiler
recognizes, such as arrays, sets or
strings
Types that implement
IEnumerable
Types that implement the
GetEnumerator pattern as documented
in the Delphi Language Guide
If you look at Generics.Collections.pas you will find the implementation for TDictionary<TKey,TValue> where it has three enumerators for TKey, TValue, and TPair<TKey,TValue> types. Embarcadero shows that they have used verbose implementation.
You could do something like this:
unit Generics.AnonEnum;
interface
uses
SysUtils,
Generics.Defaults,
Generics.Collections;
type
TAnonEnumerator<T> = class(TEnumerator<T>)
protected
FGetCurrent : TFunc<TAnonEnumerator<T>,T>;
FMoveNext : TFunc<TAnonEnumerator<T>,Boolean>;
function DoGetCurrent: T; override;
function DoMoveNext: Boolean; override;
public
Constructor Create(aGetCurrent : TFunc<TAnonEnumerator<T>,T>;
aMoveNext : TFunc<TAnonEnumerator<T>,Boolean>);
end;
TAnonEnumerable<T> = class(TEnumerable<T>)
protected
FGetCurrent : TFunc<TAnonEnumerator<T>,T>;
FMoveNext : TFunc<TAnonEnumerator<T>,Boolean>;
function DoGetEnumerator: TEnumerator<T>; override;
public
Constructor Create(aGetCurrent : TFunc<TAnonEnumerator<T>,T>;
aMoveNext : TFunc<TAnonEnumerator<T>,Boolean>);
end;
implementation
{ TEnumerable<T> }
constructor TAnonEnumerable<T>.Create(aGetCurrent: TFunc<TAnonEnumerator<T>, T>;
aMoveNext: TFunc<TAnonEnumerator<T>, Boolean>);
begin
FGetCurrent := aGetCurrent;
FMoveNext := aMoveNext;
end;
function TAnonEnumerable<T>.DoGetEnumerator: TEnumerator<T>;
begin
result := TAnonEnumerator<T>.Create(FGetCurrent,FMoveNext);
end;
{ TAnonEnumerator<T> }
constructor TAnonEnumerator<T>.Create(aGetCurrent: TFunc<TAnonEnumerator<T>, T>;
aMoveNext: TFunc<TAnonEnumerator<T>, Boolean>);
begin
FGetCurrent := aGetCurrent;
FMoveNext := aMoveNext;
end;
function TAnonEnumerator<T>.DoGetCurrent: T;
begin
result := FGetCurrent(self);
end;
function TAnonEnumerator<T>.DoMoveNext: Boolean;
begin
result := FMoveNext(Self);
end;
end.
This would allow you declare your Current and MoveNext methods anonymously.
You can do away with the factory and the interface if you add a GetEnumerator() function to your enumerator, like this:
TFilteredEnum = class
public
constructor Create(AList:TList<TMyObject>; AFilterValue:Integer);
function GetEnumerator: TFilteredEnum;
function MoveNext:Boolean; // This is where filtering happens
property Current: TMyObject;
end;
and just return self:
function TFilteredEnum.GetEnumerator: TSimpleEnumerator;
begin
result := Self;
end;
and Delphi will conveniently clean up your instance for you, just like it does any other enumerator:
var
L: TMyList;
E: TMyObject;
begin
for E in TFilteredEnum.Create(L, 7) do ;
end;
You can then extend your enumerator to use an anonymous method, which you can pass in the constructor:
TFilterFunction = reference to function (AObject: TMyObject): boolean;
TFilteredEnum = class
private
FFilterFunction: TFilterFunction;
public
constructor Create(AList:TList<TMyObject>; AFilterFunction: TFilterFunction);
...
end;
...
function TFilteredEnum.MoveNext: boolean;
begin
if FIndex >= FList.Count then
Exit(False);
inc(FIndex);
while (FIndex < FList.Count) and not FFilterFunction(FList[FIndex]) do
inc(FIndex);
result := FIndex < FList.Count;
end;
call it like this:
var
L:TMyList;
E:TMyObject;
begin
for E in TFilteredEnum.Create(L, function (AObject: TMyObject): boolean
begin
result := AObject.Value = 7;
end;
) do
begin
//do stuff here
end
end;
Then you could even make it a generic, but I wont do that here, my answer is long enough as it is.
N#
I use this approach...where the AProc performs the filter test.
TForEachDataItemProc = reference to procedure ( ADataItem: TDataItem; var AFinished: boolean );
procedure TDataItems.ForEachDataItem(AProc: TForEachDataItemProc);
var
AFinished: Boolean;
ADataItem: TDataItem;
begin
AFinished:= False;
for ADataItem in FItems.Values do
begin
AProc( ADataItem, AFinished );
if AFinished then
Break;
end;
end;