The Byte Book of Pascal. 1979.
2009 - âKinda wishing I could keep using Delphiâ
1997-2001. Borland Patent for âIDEâ.
Development system with methods for assisting a user with inputting source code
To a large extent, the progress of a particular software development project is tied to the progress of the task of writing source code or âcoding.â It is highly desirable, therefore, to facilitate this task. Although there has been some effort to address this task by increasing code reuse, one nevertheless finds that core functionality of a program must often at some point still be coded by hand. Since software components are often constructed from complex classes comprising numerous class members and methods, the developer user typically spends a lot of time looking up help information (e.g., class definitions) for such components before he or she can use such a component. Thus even with the high degree of reuse provided by component-based visual development environments, developers still must spend substantial amounts of time coding functionality to suit a new project, and of that, developers spend substantial amounts of time referencing on-line help information for understanding how to use numerous components.
What is needed is a system providing methods for assisting users with inputting source codeâthat is, the fundamental task of writing the individual code statements and expressions which comprise a software program. Such a system should free developers from having to repeatedly reference on-line reference or help materials. The present invention fulfills this and other needs.
The âBarland Software Corpâ bit there is whatâs really made my day 
Alex
1 Like
âYou donât get paid to program, you get paid to ship. Be good at your job.â - Danny Thorpe
1 Like
âOTAPI.COMâ - Beneath the hood of RAD Studio
Event-Driven, Asynchronous Development with Delphi and the LKSL (Part 1) â an Introduction
Written by Simon J Stuart
The contents of this article are now significantly deprecated!
Introduction
This article serves as an introduction to Event-Driven, Asynchronous Development as a methodology. It is part one of a series on the subject, which will build on each part to demonstrate start-to-finish how to produce a fully Event-Driven, Asynchronous system using Delphi and the LaKraven Studios Standard Library [LKSL].
This introduction focuses on explaining what, exactly, an âEvent-Driven, Asynchronous Programâ actually is, and the advantages it offers over the way most of us presently write software.
Delphi for .NET compiler preview - by John Kaster
Object Destructors and Finalizers in .NET Using C# and Delphi for .NET
Overview of the VCL for .NET - by John Kaster
TeamB member Joanna Carterâs blog,
( formatted nicely by Claude : https://claude.ai/public/artifacts/107c6274-ecfa-4df6-892e-eb0cd3ca343a )
The Observer Pattern
By Joanna Carter | June 30, 2004
Introduction
When we use Delphi to design forms and data modules, every time we place a component on the designer, several things change: the form now shows an appropriate representation of the component, the object inspector changes to show the properties of the component and, if we press Alt-F12, we see the .DFM file now contains information about the component. Whether this behaviour was modelled correctly on the Observer pattern or not, the result is that several âinterested partiesâ got to know about a change in the content of the project that we are working on.
If you read the GoF Design Patterns book, you will find much discussion on the semantics and structure of the Observer pattern. Do we want to have one subject and many observers; do we want to have many subjects and one observer; or do we want many observers to keep track of many subjects? The answer to these questions will depend to a great extent on the application that you find yourself developing. Delphi, for example may be seen as using all of these variants in some part of the IDE.
In the same book, you will see that in order to implement the Observer pattern to implement a Digital Clock observer that relates to a Clock Timer subject, use is made of multiple inheritance. But Delphi does not support multiple inheritance⊠âNo, not that old chestnut again!â, I hear you cry, âSurely what we need in Delphi v10 is multiple inheritance?â. Well, yes and no.
There are two primary mechanisms for circumventing a lack of multiple inheritance: Composition and Interfaces.
Abstract Concepts
Let us start by looking at the abstract concepts of Observers and Subjects as discussed in Gammaâs book:
IObserver
procedure Update(Subject: IInterface);
ISubject
procedure Attach(Observer: IObserver);
procedure Detach(Observer: IObserver);
procedure Notify;
As you can see the basic idea of an Observer is that it can be told when the Subject has changed; this is achieved when the Subject calls the Observer.Update method and passes itself as the Subject parameter. The ISubject consists of methods for attaching and detaching IObservers as well as a Notify method, which iterates through any Observers that are attached.
Composition
If you are not comfortable with using interfaces, which is the simplest way of implementing the Observer pattern, then you need to use Composition to supply the necessary additional functionality to existing classes. Composition involves the placing of an instance of a class that implements a desired behaviour inside a derivative of the class that needs to be extended.
TObserver = class
public
procedure Update(const Subject: TObject); virtual; abstract;
end;
TSubject = class
private
fController: TObject;
fObservers: TObjectList;
public
constructor Create(const Controller: TObject);
procedure Attach(const Observer: TObserver);
procedure Detach(const Observer: TObserver);
procedure Notify;
end;
We start off by writing an abstract class for the Observer that provides a method called Update that can be overridden, depending on the class that is to be an Observer. The Subject class can take care of managing the list of Observers and the broadcasting of updates to them.
constructor TSubject.Create(const Controller: TObject);
begin
inherited Create;
fController := Controller;
end;
procedure TSubject.Attach(const Observer: TObserver);
begin
if fObservers = nil then
fObservers := TObjectList.Create;
if fObservers.IndexOf(Observer) < 0 then
fObservers.Add(Observer);
end;
procedure TSubject.Detach(const Observer: TObserver);
begin
if fObservers <> nil then
begin
fObservers.Remove(Observer);
if fObservers.Count = 0 then
begin
fObservers.Free;
fObservers := nil;
end;
end;
end;
procedure TSubject.Notify;
var
i: Integer;
begin
if fObservers <> nil then
for i := 0 to Pred(fObservers.Count) do
TObserver(fObservers[i]).Update(fController);
end;
The constructor for the TSubject class takes a TObject as a âControllerâ parameter and this object is retained for use as the ârealâ Subject to be sent to each of the Observers; otherwise all the Observers will see is a TSubject and not the actual subject class.
Watching the Clock
The GoF book uses the example of a digital clock to demonstrate the principles of the Observer pattern and we will use that same example here.
Letâs start by designing a simple class to represent the Clock mechanism:
TClockTimer = class
private
fTimer: TTimer;
fInternalTime: TDateTime;
fSubject: TSubject;
procedure Tick(Sender: TObject);
public
constructor Create;
destructor Destroy; override;
function GetTime: TDateTime;
property Subject: TSubject read fSubject;
end;
This particular clock uses a TTimer to keep its own time and for the purpose of this example will update itself every second.
The signature of the Tick method is that of a TNotifyEvent in order to simplify the handling of the timer interval. In the Tick Method, I set an internal variable to the current time to avoid any difference in time portrayed between calls to GetTime by the attached Observers.
constructor TClockTimer.Create;
begin
inherited Create;
fTimer := TTimer.Create(nil);
fTimer.Interval := 1000;
fTimer.OnTimer := Tick;
fTimer.Enabled := True;
fSubject := TSubject.Create(self);
end;
destructor TClockTimer.Destroy;
begin
fSubject.Free;
fTimer.Enabled := False;
fTimer.Free;
inherited Destroy;
end;
function TClockTimer.GetTime: TDateTime;
begin
Result := fInternalTime;
end;
procedure TClockTimer.Tick(Sender: TObject);
begin
fInternalTime := Now;
fSubject.Notify;
end;
Notice the inclusion of a private TSubject field that will allow us to notify the list of Observers. The constructor not only creates the instance of TSubject, it also passes itself to the Subject constructor, so that the Subject can have a TClockTimer to pass to the Observers during the Notify method.
Every time the TTimer.OnTimer event fires, the internal time field is updated to the current time and then the Subjectâs Notify event is called.
Putting on a Face
Now we have a clock mechanism, we also need a face for our clock; a way of displaying the time provided by the mechanism.
TDigitalClock = class;
TClockObserver = class(TObserver)
private
fDisplay: TDigitalClock;
public
constructor Create(const Display: TDigitalClock);
procedure Update(const Subject: TObject); override;
end;
TDigitalClock = class(TPanel)
private
fObserver: TClockObserver;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Observer: TClockObserver read fObserver;
procedure ObserverUpdate(const Subject: TClockTimer);
end;
As we have said before, Delphi does not support multiple inheritance and so, to be able to derive our Digital Clock face from TPanel we also need to use composition to mix a TObserver class with the TDigitalClock class. Note also that we have to ensure that the Update method of TPanel is not suitable for responding to calls to TObserver.Update, therefore we have called our method ObserverUpdate to avoid confusion.
Just as we had to pass in the Clock Timer to the Subject, we also have to pass the Digital Clock to the Observer. The Update method of TClockObserver will call ObserverUpdate in TDigitalClock to allow the Text property of the TPanel to be updated.
constructor TClockObserver.Create(const Display: TDigitalClock);
begin
inherited Create;
fDisplay := Display;
end;
procedure TClockObserver.Update(const Subject: TObject);
begin
if (Subject is TClockTimer) then
fDisplay.ObserverUpdate(TClockTimer(Subject));
end;
The Clock Observer class derives from TObserver and overrides the Update method to check if the Subject being passed is indeed a TClockTimer and then passes that Clock Timer to the ObserverUpdate method of the Digital Clock.
constructor TDigitalClock.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fObserver := TClockObserver.Create(self);
end;
destructor TDigitalClock.Destroy;
begin
fObserver.Free;
inherited Destroy;
end;
procedure TDigitalClock.ObserverUpdate(const Subject: TClockTimer);
begin
Text := FormatDateTime('tt', Subject.GetTime);
end;
All that is left for the display class to do is to respond to the update by setting the Text property to the value provided by the Clock Timer subject.
Observer Interfaces
Instead of using Composition to circumvent the lack of multiple inheritance, we can also use Interfaces in a way that allows us to support the concept of deriving a class that âinheritsâ the behaviour of more than one type.
When describing multiple inheritance, the example of an amphibious vehicle is often used. But the concept of an amphibious vehicle does not truly represent an object that is truly a car and truly a boat; surely it is, more accurately, a vehicle that can behave like a car or like a boat. What interfaces allow us to do is to design classes that support multiple behaviours. So let us go on to look at how we can simplify the Observer pattern using interfaces.
IObserver = interface
['{xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}']
procedure Update(Subject: IInterface);
end;
ISubject = interface
['{xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}']
procedure Attach(Observer: IObserver);
procedure Detach(Observer: IObserver);
procedure Notify;
end;
In the above example using Composition, we had to write an abstract class called TObserver that had just the one method, Update, but if you look at these interface declarations, you actually have the equivalent of an abstract class. Essentially an interface is almost the same as an abstract class with a few more features like reference counting and the ability to be mixed with other interfaces in a class.
As with the non-interface method of implementing the Observer pattern, we can implement the ISubject interface once and for all and aggregate an instance of TSubject into our Subject class to avoid rewriting the same code over and over again.
TSubject = class(TInterfacedObject, ISubject)
private
fController: Pointer;
fObservers: IInterfaceList;
procedure Attach(Observer: IObserver);
procedure Detach(Observer: IObserver);
procedure Notify;
public
constructor Create(const Controller: IInterface);
end;
Gamma uses a template List container class to maintain the list of Observers, but as we are not using C++ we will use a IInterfaceList as this is the correct way to store lists of references to interfaces. So letâs go on to look at the implementation for this base TSubject class:
constructor TSubject.Create(const Controller: IInterface);
begin
inherited Create;
fController := Pointer(Controller);
end;
procedure TSubject.Attach(AObserver: IObserver);
begin
if fObservers = nil then
fObservers := TInterfaceList.Create;
fObservers.Add(AObserver);
Notify;
end;
procedure TSubject.Detach(AObserver: IObserver);
begin
if fObservers <> nil then
begin
fObservers.Remove(AObserver);
if fObservers.Count = 0 then
fObservers := nil;
end;
end;
procedure TSubject.Notify;
var
i: Integer;
begin
if fObservers <> nil then
for i := 0 to Pred(fObservers.Count) do
(fObservers[i] as IObserver).Update(IInterface(fController));
end;
The constructor takes an IInterface reference to the aggregating object (in our example the Clock Timer) and stores it in a Pointer field; this âweak referenceâ technique avoids reference-counting problems that could cause a memory leak due to the mutual references between the TSubject and its aggregating class.
The Attach and Detach methods are fairly straightforward, but I will go into a little more detail with the Notify method. This method traverses the list of Observers that are attached to the Subject and calls the Update method for each observer that it finds. The fController field that is the real subject (Clock Timer) has to be cast back to an IInterface in order to be passed to the Update method of the Observer interface.
A Universal Ticker
Here is the interface definition for the âmechanismâ of our clock:
IClockTimer = interface
['{xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}']
function GetTime: TDateTime;
end;
The declaration of the TClockTimer implementing class is slightly different from the non-interface version. Instead of deriving from TObject, it derives from TInterfacedObject in order to give us a ready-made implementation of IInterface and then also implements the Clock Timer and Subject interfaces.
TClockTimer = class(TInterfacedObject, IClockTimer, ISubject)
private
fTimer: TTimer;
fInternalTime: TDateTime;
fSubject: ISubject;
function GetTime: TDateTime;
procedure Tick(Sender: TObject);
property Subject: ISubject read fSubject implements ISubject;
public
constructor Create;
end;
The main differences are: all methods (apart from the constructor) and properties are now private because they will only be accessed through the supported Interfaces. The Subject property is declared with the implements directive so that any attempt to reference the ISubject interface will be redirected to the embedded TSubject instance.
destructor TClockTimer.Destroy;
begin
fTimer.Enabled := False;
fTimer.Free;
inherited Destroy;
end;
The only difference in the code required for the interface version of this class is the omission of the call to fSubject.Free; this is not necessary or possible, as it will automatically fall out of scope when the Clock Timer is destroyed and Free is not a method of IInterface.
Widgets and Other Furry Animals
In Gammaâs book, the Digital Clock class is derived from a Widget class and from the abstract Observer class previously discussed. As we are not able to use multiple inheritance, we are going to have to find another way of implementing a Widget that is also an Observer. For a very simple demonstration component that you can put on a form, I decided that my âWidgetâ would be a TPanel. Here is the class declaration:
TDigitalClock = class(TPanel, IObserver)
private
procedure IObserver.Update = ObserverUpdate;
procedure ObserverUpdate(const Subject: IInterface);
end;
procedure TDigitalClock.ObserverUpdate(const Subject: IInterface);
var
Obj: IClockTimer;
begin
Subject.QueryInterface(IClockTimer, Obj);
if Obj <> nil then
Caption := FormatDateTime('tt', Obj.GetTime);
end;
Because TPanel already has an Update method that is unsuitable for our purposes, we have to redirect the IObserver.Update method to another method, which I have called ObserverUpdate.
In ObserverUpdate you will see that a check is made to ensure that the Subject being passed in is really a Clock Timer and then, if it is a valid subject, the visual representation on the âWidgetâ is updated using the GetTime method of the Subject.
After installing this component into the VCL, the only other code needed to get a demonstration going is to declare a private variable of type IClockTimer on a test form then add a button and the following event handlers:
procedure TForm1.FormCreate(Sender: TObject);
begin
fClockTimer := TClockTimer.Create;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
(fClockTimer as ISubject).Attach(DigitalClock1 as IObserver);
end;
Any number of Digital Clocks can be placed on the form and attached to the Clock Timer and they will all be notified and kept up to date every second.
Comments from the Original Post
Reader Corrections and Discussions
Lars Christian Svane pointed out a code error:
The line
(DigitalClock1 as ISubject).Attach(fClockTimer as IObserver);should be:(fClockTimer as ISubject).Attach(DigitalClock1 as IObserver);
Wango suggested improvements regarding the weak reference implementation, questioning whether fController should be IInterface type rather than Pointer.
Joanna Carter (the author) responded:
The use of the Pointer is known as a âweak referenceâ and is used to break the circular refcount problem where an outer class holds a reference to an inner class and an inner class holds a reference to the outer class. This prevents memory leaks by avoiding circular reference counting.
Originally published on June 30, 2004 at http://blogs.teamb.com/joannacarter/articles/690.aspx
Directly related question on Stackoverflow :
and one more :
(again, thanks Claude. https://claude.ai/public/artifacts/501c1781-18a0-42d8-bd20-b700ea0221b3 )
The Iterator Pattern
By Joanna Carter | June 30, 2004
Introduction
Most of the time, when we want to iterate through a list, we tend to go for the option of using a âforâ loop with an integer variable to access the indexed Items property of the list. That is all very well if the list actually has an indexed property, but there are times when it may not be desirable or even possible to provide an integer based index for a list.
Enter the Iterator - a mechanism for iterating (hence the name) through a list without having to use an integer property.
TCustomerList = class
private
fItems: TObjectList;
public
procedure Add(const Item: TCustomer);
procedure Insert(const Item, Before: TCustomer);
procedure Insert(Idx: Integer; const Item: TCustomer);
procedure Delete(Idx: Integer);
procedure Remove(const Item: TCustomer);
procedure Clear;
function Contains(const Item: TCustomer): Boolean;
function GetCount: Integer;
function GetItem(Idx: Integer): TCustomer;
end;
If we take this Customer List class, we see that it is possible to use a âforâ loop to iterate through the list and we will use this class as basis for demonstrating how to implement an Iterator instead.
First, let us take away the public ability to do anything with this list that knows anything about an Integer index:
TCustomerList = class
private
fItems: TObjectList;
protected
function GetItem(Idx: Integer): TCustomer;
public
procedure Add(const Item: TCustomer);
procedure Insert(const Item, Before: TCustomer);
procedure Remove(const Item: TCustomer);
procedure Clear;
function Contains(const Item: TCustomer): Boolean;
function GetCount: Integer;
end;
Now we can still do everything, apart from retrieving Customers from the list. For the sake of this example, we do not want to be able to access a single Customer by an Integer index, because it is very unusual for a Customer to know what their indexed position is in the list. You will notice that the GetItem method is still in the class, but it has been placed in the protected section of the class to prevent clients of this class accessing it.
Basic Iterator Implementation
TCustomerIterator = class
private
fList: TCustomerList;
fCurrentItem: Integer;
protected
procedure Reset;
function Next: Boolean; virtual;
function CurrentItem: TCustomer;
public
constructor Create(const List: TCustomerList);
end;
There are several variations of the Iterator pattern that are available, but I have found that this version promotes the best clarity and ease of coding when it comes to using it in applications. The class takes a Customer List as a constructor parameter, to which it keeps a reference for later use.
constructor TCustomerIterator.Create(const List: TCustomerList);
begin
inherited Create;
fList := List;
Reset;
end;
procedure TCustomerIterator.Reset;
begin
fCurrentItem := -1;
end;
function TCustomerIterator.Next: Boolean;
begin
Result := (fList <> nil) and
(fCurrentItem < (fList.GetCount - 1));
if Result then
Inc(fCurrentItem);
end;
function TCustomerIterator.CurrentItem: TCustomer;
begin
if (fList <> nil) and ((fCurrentItem >= 0) and
(fCurrentItem < fList.GetCount)) then
Result := fList.GetItem(fCurrentItem)
else
Result := nil;
end;
Internally to the Iterator class we still have to use an Integer variable to keep track of where we are in the list. Although we have said that we donât want to access the list using an Integer index, that rule only applies to public clients of the list class.
When the Iterator is created, the Reset method sets the internal integer to -1, which is before the first item in the list; this ensures that if someone calls CurrentItem before they call Next, they will not receive a valid object, because the Iterator has not yet âstartedâ.
The Next method checks to see if there is an item in the list that it can move to and, if so, it increments the internal index ready for any call to the CurrentItem method.
The CurrentItem method does a double check to ensure that it can return a valid item; if yes, it returns that item, if no, it returns nil. You could always change that behaviour to one where an exception is raised if the Iterator has gone beyond the end of the List.
Friend Classes for Cross-Unit Access
The only problem with the above code is that it will not work if the Iterator class is not in the same unit as the List class. This is because the CurrentItem method tries to access the protected GetItem method of the List class, which it cannot otherwise see.
In order to overcome this problem, the Iterator class should be regarded as a friend of the List class and allowed privileged access to the protected GetItem method of the list. This can be arranged in one of two ways: If it is envisaged that there will only be the need for one type of iterator, then the Iterator class can be placed in the same unit as the List class, thus allowing access to the non-public members of the List class. If there may be more than one type of Iterator for the List, then we can use a trick in Delphi that allows us to see the protected members of a class in another unit.
implementation
type
TCustomerListFriend = class(TCustomerList)
end;
// ...
function TCustomerIterator.CurrentItem: TCustomer;
begin
if (fList <> nil) and ((fCurrentItem >= 0) and
(fCurrentItem < fList.GetCount)) then
Result := TCustomerListFriend(fList).GetItem(fCurrentItem)
else
Result := nil;
end;
By declaring a âfriendâ class that derives from the Customer List class in the same unit as the Iterator, we bring any protected members of the Customer List class into the visibility of the Iterator class. All that is needed now is to alter the line that calls the GetItem method by typecasting the List to the derived class.
Using the Iterator
The Iterator class that we have just described can be created in one of two ways: If it is possible that more than one type of Iterator may be necessary, both the List and the Iterator could be created into local variables and the List passed to the constructor of the Iterator in the calling method:
procedure TTest.PrintCustomers;
var
list: TCustomerList;
iter: TCustomerIterator;
begin
list := TCustomerList.Create;
try
iter := TCustomerIterator.Create(list);
try
while iter.Next do
WriteLn(iter.CurrentItem.Name);
finally
iter.Free;
end;
finally
list.Free;
end;
end;
Factory Method Approach
There is, however, an alternative way of creating the Iterator - from within the List itself. We need to add a method to the List class:
TCustomerList = class
// ...
public
// ...
function GetIterator: TCustomerIterator;
end;
implementation
function TCustomerList.GetIterator: TCustomerIterator;
begin
Result := TCustomerIterator.Create(self);
end;
Or we could even change the Iterator class to accept a TObjectList as the parameter to the constructor and keep a reference to that for the Iterator to use instead of the Customer List; this would remove the need for the protected GetItem method in the List class, as the Iterator could use the indexed GetItem method of the TObjectList. But this would only work if you could guarantee that the internal list would always be a TObjectList and that the Iterator would be constructed inside the List class.
Using this method of asking the List for an Iterator gives us calling code like this:
procedure TTest.PrintCustomers;
var
list: TCustomerList;
iter: TCustomerIterator;
begin
list := TCustomerList.Create;
try
iter := list.GetIterator;
try
while iter.Next do
WriteLn(iter.CurrentItem.Name);
finally
iter.Free;
end;
finally
list.Free;
end;
end;
Using Iterators Within the List Class
Creating the Iterator from within the list class also has other advantages; it will allow us to simplify the code internal to the List class and to provide more features.
TCustomerList = class
// ...
public
// ...
function Contains(const Item: TCustomer): Boolean;
procedure Assign(const Other: TCustomerList);
end;
Without an Iterator, we would normally use an Integer âforâ loop to implement the Contains method:
function TCustomerList.Contains(const Item: TCustomer): Boolean;
var
i: Integer;
begin
Result := False;
for i := 0 to Pred(fItems.Count) do
if fItems[i] = Item then
begin
Result := True;
Break;
end;
end;
Now, we can replace that code with the iterator that we have just created:
function TCustomerList.Contains(const Item: TCustomer): Boolean;
var
iter: TCustomerIterator;
begin
Result := False;
iter := GetIterator;
try
while iter.Next and not Result do
if iter.CurrentItem = Item then
Result := True;
finally
iter.Free;
end;
end;
We can also use the Iterator to simplify the code required for assigning the contents of one list to another:
procedure TCustomerList.Assign(const Other: TCustomerList);
var
iter: TCustomerIterator;
begin
Clear;
iter := Other.GetIterator;
try
while iter.Next do
Add(Iter.CurrentItem);
finally
iter.Free;
end;
end;
Skip Iterators
There are occasions when we may want to be selective in the items that we iterate over in a list. For example, we may only want to print out all Customers that have their Credit put on stop.
Using integer indexes we would have to write the code that selects those Customers in the calling routine:
procedure TTest.PrintBadCustomers;
var
list: TCustomerList;
i: Integer;
begin
list := TCustomerList.Create;
try
for i := 0 to Pred(list.Count) do
if list[i].CreditStop then
WriteLn(list[i].Name);
finally
list.Free;
end;
end;
But we can reuse our PrintCustomers routine almost without alteration by creating an Iterator that will only return bad Customers to the CurrentItem method.
TBadCustomerIterator = class(TCustomerIterator)
// ...
protected
// ...
function Next: Boolean; override;
// ...
end;
All we need to do is to override the Next method to implement any filtering that is required.
function TBadCustomerIterator.Next: Boolean;
begin
repeat
Result := inherited Next;
until not Result or (Result and CurrentItem.CreditStop);
end;
Note: The original code in the article had a bug - it would create an infinite loop. The corrected version above includes the not Result or condition to prevent this.
procedure TTest.PrintCustomers(Bad: Boolean);
var
list: TCustomerList;
iter: TCustomerIterator;
begin
list := TCustomerList.Create;
try
if Bad then
iter := TBadCustomerIterator.Create(list)
else
iter := TCustomerIterator.Create(list);
try
while iter.Next do
WriteLn(iter.CurrentItem.Name);
finally
iter.Free;
end;
finally
list.Free;
end;
end;
Traversing Trees
The following code is from an old project and is not meant to be fully comprehensible; it is just meant to show that iterators can be used with a tree structure that has no concept of Integer indexing. Each node uses an iterator to access its children and the main iterator traverses the tree using a pointer to the current node rather than an Integer.
type
TTreeTopDownIterator = class
public
function CurrentItem: TTreeNode;
function IsDone: Boolean;
procedure Next;
procedure Reset;
end;
implementation
procedure TTreeTopDownIterator.Next;
var
TestNode: TTreeNode;
begin
if fCurrentNode.IsLeaf then
// there are no children
begin
if fCurrentNode = fRootNode then // there is only one node
fCurrentNode := nil
else
begin
TestNode := fCurrentNode.Parent;
repeat
// test for siblings
TestNode.Children.Next;
if TestNode.Children.IsDone then
// no siblings found
begin
TestNode := TestNode.Parent;
if TestNode = nil then
// we are in root node
begin
fCurrentNode := nil;
Break;
end;
end
else
// siblings found
begin
// move to next sibling
fCurrentNode := TestNode.Children.CurrentNode;
Break;
end;
// recurse up tree to find next node
until (TestNode = fRootNode) and TestNode.Children.IsDone;
end;
end
else
// there are children
begin
fCurrentNode.Children.First;
fCurrentNode := fCurrentNode.Children.CurrentNode;
end;
end;
This example uses the pattern of Iterator found in the GoF book; the only real differences between this style and the first one we looked at are: the next method is a procedure rather than a Boolean function, and there is an IsDone method to test for the end of the iteration. For those reasons the calling code is slightly different:
var
iter: TTreeTopDownIterator;
begin
iter := TTreeTopDownIterator.Create(aTree);
while not iter.IsDone do
begin
WriteLn(iter.CurrentItem.Text);
iter.Next;
end;
end;
Comments from the Original Post
Reader Feedback and Corrections
Lee Grissom asked about using interfaces to avoid try..finally blocks:
Is it possible to get back the iterator as an Interface to avoid the try..finally block?
Joanna Carter responded:
The only time you will experience problems mixing object and interface references is with Delphi for Win32. However, in this case, there should be no problem as the GetIterator method is essentially a Factory Method. The Iterator as an interface would live for as long as needed and then become invalid at the end of the method it was used in.
Ben Kalegin suggested improvements:
- Follow naming patterns like Java has, for example, Next method usually returns object (like your method CurrentItem) and hasNext returns boolean
- IMHO it is not good idea to increment in .Next, this method can be additionally called for some purposes inside loop.
- You omit most exciting part of iterators: multithread synchronization patterns.
Wilbert raised concerns about deletions:
I thought that the iterator was supposed to hold its own list of items rather than depending on the original list? The purpose of this would be:
while it.Next do CustomerList.Delete(it.CurrentItem);Which in your example would cause an index out of bounds.
Joanna Carter replied:
You would never normally use an Iterator for deletions unless you first created a List that contains the items to be deleted and then use the Iterator from that list to get the items to delete from the main list. My standard Iterator is attached as an Observer to the list and when the contents of the list changes the Iterator is automatically invalidated by setting it to the end of the list.
Stephen Melnyk caught the infinite loop bug:
In the Skip Iterators section, you implement TBadCustomerIterator.Next with:
repeat Result := inherited Next; until Result and CurrentItem.CreditStopIsnât this an infinite loop? The last item in the list is going to return False from the inherited Next.
Shawn Stamps provided the fix:
Yes, it is an infinite loop. The correct code would be:
Repeat Result := inherited Next; Until Not Result Or Result And CurrentItem.CreditStop;
Originally published on June 30, 2004 at http://blogs.teamb.com/joannacarter/articles/
Anonymous Methods and Closures in Delphi 2010 - Phil Gilmore