On 15/06/2010, Juha Manninen wrote:
>
> Thanks.
> Java shines with its container classes. Iterator interface and support for
> generics types are just cool. It all could be implemented with Object Pascal
> as well.
Yes, java is great in that way, but it was decided not to extend the
classes in the RTL with such functionality. So I implemented them as
external classes that gets created by a Factory Method, using a
lazyman's Singleton.
It can now be used as follows... Good news is that any iteration code
over any list class (object list, string list, tree view) now looks
the same. No need to know if the list class is 1-based or 0-based
etc.. The container/list class can now change internally, and no
iteration code needs to change either.
var
itr: IStringIterator
begin
itr := gIteratorFactory.StringIterator(lst);
if Assigned(itr) then
begin
while itr.HasNext do
Add(itr.Next);
end;
itr := nil;
end;
I think I made some changes to the units included with the article, so
I attached the latest ones I have.
--
Regards,
- Graeme -
_______________________________________________
fpGUI - a cross-platform Free Pascal GUI toolkit
http://opensoft.homeip.net/fpgui/
unit iterator_intf;
{$I M2Defines.inc}
interface
uses
Classes
,SysUtils
,tiObject
;
type
{ A custom exception class }
ENoIteratorImpl = class(Exception);
EUniDirectionalIterator = class(Exception);
{ Standard iterators }
ITBIterator = interface(IInterface)
['{9C2BC10D-54C8-4B59-88B5-A564921CF0E3}']
function HasNext: Boolean;
function Next: TObject;
function HasPrevious: Boolean;
function Previous: TObject;
end;
ITBStringIterator = interface(IInterface)
['{B2A449B4-5D0A-4F14-AC11-CA055EDA3ED7}']
function HasNext: Boolean;
function Next: string;
function HasPrevious: Boolean;
function Previous: string;
end;
ITBStringAndObjectIterator = interface(ITBStringIterator)
['{287373DC-A90D-400E-BAEE-C85474C317A8}']
function HasNextObject: Boolean;
function NextObject: TObject;
function HasPreviousObject: Boolean;
function PreviousObject: TObject;
end;
ITBInterfaceIterator = interface
['{9B599C5B-4BBB-43F6-AF8E-09FEE9AE0E20}']
function HasNext: Boolean;
function Next: IInterface;
function HasPrevious: Boolean;
function Previous: IInterface;
end;
{ TODO:
More interfaces could be added for collections like:
TTreeView, TStringGrid etc... }
{ Filtered iterators }
ITBFilteredStringIterator = interface(ITBStringIterator)
['{CF1B9E2D-DD05-4D15-95C6-686EAFA4ED82}']
function GetFilter: string;
procedure SetFilter(const AValue: string);
property Filter: string read GetFilter write SetFilter;
end;
{ tiOPF ObjectList iterator }
ItiOPFListIterator = interface(IInterface)
['{4AB041E6-381F-4B72-8AD2-BE21B83039E6}']
function HasNext: Boolean;
function Next: TtiObject;
function HasPrevious: Boolean;
function Previous: TtiObject;
end;
{ TODO:
More filtered versions of the standard iterators could
be added here... }
{ Iterator Factory }
TTBIteratorFactory = class(TObject)
function Iterator(const ASource: TObject): ITBIterator;
function StringIterator(const ASource: TObject): ITBStringIterator;
function StringAndObjectIterator(const ASource: TObject): ITBStringAndObjectIterator;
function InterfaceIterator(const ASource: TObject): ITBInterfaceIterator;
function FilteredStringIterator(const ASource: TObject; const AFilter: string): ITBFilteredStringIterator;
function tiListIterator(const ASource: TtiObjectList): ItiOPFListIterator;
end;
{ Global iterator factory singleton }
function gIteratorFactory: TTBIteratorFactory;
implementation
uses
iterator_impl;
var
uIteratorFactory: TTBIteratorFactory;
const
cNoIteratorImpl = 'No Iterator implementation found for <%s>';
{ The lazy mans singleton implementation, but it does the job just fine. }
function gIteratorFactory: TTBIteratorFactory;
begin
if not Assigned(uIteratorFactory) then
uIteratorFactory := TTBIteratorFactory.Create;
Result := uIteratorFactory;
end;
{ TTBIteratorFactory }
function TTBIteratorFactory.Iterator(const ASource: TObject): ITBIterator;
begin
if ASource is TList then
Result := TTBListIterator.CreateCustom(TList(ASource))
else if ASource is TCollection then
Result := TTBCollectionIterator.CreateCustom(TCollection(ASource))
//else if ASource is TTreeNodes then
//Result := TTBTreeNodesIterator.CreateCustom(TTreeNodes(ASource))
else
raise ENoIteratorImpl.CreateFmt(cNoIteratorImpl, [ASource.ClassName]);
end;
function TTBIteratorFactory.StringIterator(const ASource: TObject): ITBStringIterator;
begin
if ASource is TStrings then
Result := TTBStringsIterator.CreateCustom(TStrings(ASource))
else
raise ENoIteratorImpl.CreateFmt(cNoIteratorImpl, [ASource.ClassName]);
end;
function TTBIteratorFactory.StringAndObjectIterator(const ASource: TObject): ITBStringAndObjectIterator;
begin
if ASource is TStrings then
Result := TTBStringsIterator.CreateCustom(TStrings(ASource))
else
raise ENoIteratorImpl.CreateFmt(cNoIteratorImpl, [ASource.ClassName]);
end;
function TTBIteratorFactory.InterfaceIterator(const ASource: TObject): ITBInterfaceIterator;
begin
if ASource is TInterfaceList then
Result := TTBInterfaceListIterator.CreateCustom(TInterfaceList(ASource))
else
raise ENoIteratorImpl.CreateFmt(cNoIteratorImpl, [ASource.ClassName]);
end;
function TTBIteratorFactory.FilteredStringIterator(const ASource: TObject; const AFilter: string): ITBFilteredStringIterator;
begin
if ASource is TStrings then
begin
Result := TTBFilteredStringsIterator.CreateCustom(TStrings(ASource));
Result.Filter := AFilter;
end
else
raise ENoIteratorImpl.CreateFmt(cNoIteratorImpl, [ASource.ClassName]);
end;
function TTBIteratorFactory.tiListIterator(const ASource: TtiObjectList): ItiOPFListIterator;
begin
if ASource <> nil then
Result := TtiOPFListIterator.CreateCustom(ASource)
else
raise ENoIteratorImpl.CreateFmt(cNoIteratorImpl, [ASource.Classname]);
end;
initialization
uIteratorFactory := nil;
finalization
uIteratorFactory.Free;
end.
unit iterator_impl;
{$I M2Defines.inc}
interface
uses
Classes
,SysUtils
,Regex { to be used with filtered string iterator }
,iterator_intf
,contnrs
,tiObject
;
type
TTBStringsIterator = class(TInterfacedObject, ITBStringIterator, ITBStringAndObjectIterator)
private
FStrings: TStrings;
FCursor: Integer;
{ Interface methods should always be private because
we will only ever access them via an Interface,
never via an Object instance }
{ Interface: ITBStringIterator and ITBStringAndObjectIterator }
function HasNext: Boolean;
function Next: string;
function HasPrevious: Boolean;
function Previous: string;
{ Interface: ITBStringAndObjectIterator }
function HasNextObject: Boolean;
function NextObject: TObject;
function HasPreviousObject: Boolean;
function PreviousObject: TObject;
public
constructor CreateCustom(const ASource: TStrings); virtual;
end;
TTBListIterator = class(TInterfacedObject, ITBIterator)
private
FList: TList;
FCursor: Integer;
{ Interface: ITBIterator }
function HasNext: Boolean;
function Next: TObject;
function HasPrevious: Boolean;
function Previous: TObject;
public
constructor CreateCustom(const ASource: TList); virtual;
end;
TTBCollectionIterator = class(TInterfacedObject, ITBIterator)
private
FCollection: TCollection;
FCursor: Integer;
{ Interface: ITBIterator }
function HasNext: Boolean;
function Next: TObject;
function HasPrevious: Boolean;
function Previous: TObject;
public
constructor CreateCustom(const ASource: TCollection); virtual;
end;
TTBInterfaceListIterator = class(TInterfacedObject, ITBInterfaceIterator)
private
FList: TInterfaceList;
FCursor: integer;
{ Interface: ITBinterfaceIterator }
function HasNext: Boolean;
function Next: IInterface;
function HasPrevious: Boolean;
function Previous: IInterface;
public
constructor CreateCustom(const ASource: TInterfaceList); virtual;
end;
TTBFilteredStringsIterator = class(TTBStringsIterator, ITBFilteredStringIterator)
private
FNextIndex: Integer;
FRegex: TRegexEngine;
{ Interface: ITBFilteredStringIterator }
function GetFilter: string;
procedure SetFilter(const AValue: string);
{ Interface: ITBStringIterator and ITBStringAndObjectIterator }
function HasNext: Boolean;
function Next: string;
function HasPrevious: Boolean;
function Previous: string;
public
constructor CreateCustom(const ASource: TStrings); override;
destructor Destroy; override;
end;
TTBObjectListIterator = class(TInterfacedObject, ITBIterator)
private
FList: TObjectList;
FCursor: Integer;
{ Interface: ITBIterator }
function HasNext: Boolean;
function Next: TObject;
function HasPrevious: Boolean;
function Previous: TObject;
public
constructor CreateCustom(const ASource: TObjectList); virtual;
end;
TtiOPFListIterator = class(TInterfacedObject, ItiOPFListIterator)
private
FList: TtiObjectList;
FCursor: Integer;
{ Interface: ItiOPFListIterator }
function HasNext: Boolean;
function Next: TtiObject;
function HasPrevious: Boolean;
function Previous: TtiObject;
public
constructor CreateCustom(const ASource: TtiObjectList); virtual;
end;
implementation
{ TTBStringsIterator }
function TTBStringsIterator.HasNext: Boolean;
begin
Result := False;
if Assigned(FStrings) then
if FCursor < FStrings.Count - 1 then
Result := True;
end;
function TTBStringsIterator.Next: string;
begin
Result := '';
if HasNext then
begin
Inc(FCursor, 1);
Result := FStrings.Strings[FCursor];
end;
end;
function TTBStringsIterator.HasPrevious: Boolean;
begin
Result := False;
if Assigned(FStrings) then
if FCursor > 0 then
Result := True;
end;
function TTBStringsIterator.Previous: string;
begin
Result := '';
if HasPrevious then
begin
Dec(FCursor, 1);
Result := FStrings.Strings[FCursor];
end;
end;
function TTBStringsIterator.HasNextObject: Boolean;
begin
Result := False;
if Assigned(FStrings) then
if FCursor < FStrings.Count - 1 then
Result := FStrings.Objects[FCursor] <> nil;
end;
function TTBStringsIterator.NextObject: TObject;
begin
Result := nil;
if HasNextObject then
// Note that Next(...) increments the FCursor
Result := FStrings.Objects[FCursor];
end;
function TTBStringsIterator.HasPreviousObject: Boolean;
begin
Result := False;
if Assigned(FStrings) then
if FCursor > 0 then
Result := FStrings.Objects[FCursor] <> nil;
end;
function TTBStringsIterator.PreviousObject: TObject;
begin
Result := nil;
if HasPreviousObject then
// Note that Previous(...) decrements the FCursor
Result := FStrings.Objects[FCursor];
end;
constructor TTBStringsIterator.CreateCustom(const ASource: TStrings);
begin
inherited Create;
FStrings := ASource;
FCursor := -1;
end;
{ TTBListIterator }
function TTBListIterator.HasNext: Boolean;
begin
Result := False;
if Assigned(FList) then
if FCursor < FList.Count - 1 then
Result := True;
end;
function TTBListIterator.Next: TObject;
begin
Result := nil;
if HasNext then
begin
Inc(FCursor, 1);
result := TObject(FList.Items[FCursor]);
end;
end;
function TTBListIterator.HasPrevious: Boolean;
begin
Result := False;
if Assigned(FList) then
begin
if FCursor > 0 then
Result := True;
end;
end;
function TTBListIterator.Previous: TObject;
begin
Result := nil;
if HasPrevious then
begin
Dec(FCursor, 1);
Result := TObject(FList.Items[FCursor]);
end;
end;
constructor TTBListIterator.CreateCustom(const ASource: TList);
begin
inherited Create;
FList := ASource;
FCursor := -1;
end;
{ TTBCollectionIterator }
function TTBCollectionIterator.HasNext: Boolean;
begin
Result := False;
if Assigned(FCollection) then
if FCursor < FCollection.Count - 1 then
Result := True;
end;
function TTBCollectionIterator.Next: TObject;
begin
Result := nil;
if HasNext then
begin
Inc(FCursor, 1);
result := FCollection.Items[FCursor];
end;
end;
function TTBCollectionIterator.HasPrevious: Boolean;
begin
Result := False;
if Assigned(FCollection) then
if FCursor > 0 then
Result := True;
end;
function TTBCollectionIterator.Previous: TObject;
begin
Result := nil;
if HasPrevious then
begin
Dec(FCursor, 1);
Result := FCollection.Items[FCursor];
end;
end;
constructor TTBCollectionIterator.CreateCustom(const ASource: TCollection);
begin
inherited Create;
FCollection := ASource;
FCursor := -1;
end;
{ TTBFilteredStringsIterator }
function TTBFilteredStringsIterator.GetFilter: string;
begin
Result := FRegex.RegexString;
end;
procedure TTBFilteredStringsIterator.SetFilter(const AValue: string);
const
cFilterErr = 'Error in Filter string at position %d with ErrorCode %d. Filter string <%s>';
var
LErrorCode: TRegexError;
LErrorPos: integer;
begin
if AValue <> FRegex.RegexString then
begin
FRegex.RegexString := AValue;
if not FRegex.Parse(LErrorPos, LErrorCode) then
raise Exception.CreateFmt(cFilterErr, [LErrorPos, Ord(LErrorCode), AValue]);
end;
FNextIndex := -1;
end;
function TTBFilteredStringsIterator.HasNext: Boolean;
var
LIndex: integer;
LMatchPos: integer;
LOffset: integer;
begin
Result := False;
if GetFilter = '' then
begin
Result := inherited HasNext;
if Result then
FNextIndex := FCursor + 1;
end
else
begin
if FCursor < FStrings.Count - 1 then
begin
{ If we haven't already calculated the next matching item }
if FNextIndex = -1 then
begin
LIndex := FCursor + 1;
{ Peek ahead to find the next matching string }
while (LIndex < FStrings.Count) and (FNextIndex = -1) do
begin
{ reset MatchString parameters }
LOffset := 0;
LMatchPos := 0;
if FRegex.MatchString(FStrings.Strings[LIndex], LMatchPos, LOffset) then
FNextIndex := LIndex;
Inc(LIndex);
end;
end;
if FNextIndex <> -1 then
Result := True;
end;
end; { if..else }
end;
function TTBFilteredStringsIterator.Next: string;
begin
Result := '';
if HasNext then
begin
FCursor := FNextIndex;
FNextIndex := -1;
Result := FStrings.Strings[FCursor];
end;
end;
function TTBFilteredStringsIterator.HasPrevious: Boolean;
begin
Result := False; // Filtered String is uni-directional
end;
function TTBFilteredStringsIterator.Previous: string;
begin
Result := '';
raise EUniDirectionalIterator.Create('Filtered String Iterator is uni-directional (forward) only.');
end;
constructor TTBFilteredStringsIterator.CreateCustom(const ASource: TStrings);
begin
inherited CreateCustom(ASource);
FRegex := TRegexEngine.Create('');
FRegex.IgnoreCase := True;
FNextIndex := -1;
end;
destructor TTBFilteredStringsIterator.Destroy;
begin
FRegex.Free;
inherited Destroy;
end;
{ TTBInterfaceListIterator }
function TTBInterfaceListIterator.HasNext: Boolean;
begin
Result := False;
if Assigned(FList) then
if FCursor < FList.Count - 1 then
Result := True;
end;
function TTBInterfaceListIterator.Next: IInterface;
begin
Result := nil;
if HasNext then
begin
Inc(FCursor, 1);
Result := FList.Items[FCursor];
end;
end;
function TTBInterfaceListIterator.HasPrevious: Boolean;
begin
Result := False;
if Assigned(FList) then
if FCursor > 0 then
Result := True;
end;
function TTBInterfaceListIterator.Previous: IInterface;
begin
Result := nil;
if HasPrevious then
begin
Dec(FCursor, 1);
Result := FList.Items[FCursor];
end;
end;
constructor TTBInterfaceListIterator.CreateCustom(const ASource: TInterfaceList);
begin
inherited Create;
FList := ASource;
FCursor := -1;
end;
{ TTBObjectListIterator }
function TTBObjectListIterator.HasNext: Boolean;
begin
Result := False;
if Assigned(FList) then
if FCursor < FList.Count - 1 then
Result := True;
end;
function TTBObjectListIterator.Next: TObject;
begin
result := nil;
if HasNext then
begin
Inc(FCursor);
result := FList.Items[FCursor];
end;
end;
function TTBObjectListIterator.HasPrevious: Boolean;
begin
Result := False;
if Assigned(FList) then
if FCursor > 0 then
Result := True;
end;
function TTBObjectListIterator.Previous: TObject;
begin
result := nil;
if HasPrevious then
begin
Dec(FCursor);
result := FList.Items[FCursor];
end;
end;
constructor TTBObjectListIterator.CreateCustom(const ASource: TObjectList);
begin
inherited Create;
FList := ASource;
FCursor := -1;
end;
{ TtiOPFListIterator }
function TtiOPFListIterator.HasNext: Boolean;
begin
Result := False;
if Assigned(FList) then
if FCursor < FList.Count - 1 then
Result := True;
end;
function TtiOPFListIterator.Next: TtiObject;
begin
result := nil;
if HasNext then
begin
Inc(FCursor);
result := FList.Items[FCursor];
end;
end;
function TtiOPFListIterator.HasPrevious: Boolean;
begin
Result := False;
if Assigned(FList) then
if FCursor > 0 then
Result := True;
end;
function TtiOPFListIterator.Previous: TtiObject;
begin
result := nil;
if HasPrevious then
begin
Dec(FCursor);
result := FList.Items[FCursor];
end;
end;
constructor TtiOPFListIterator.CreateCustom(const ASource: TtiObjectList);
begin
inherited Create;
FList := ASource;
FCursor := -1;
end;
end.
--
_______________________________________________
Lazarus mailing list
[email protected]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
