---

Collections (sometimes called containers) are an important foundation for object-oriented programming, but Delphi has traditionally been rather weak in this area. The TList and TStrings classes are useful but limited. The problem until recently has been the difficulty of writing a generic class. Delphi lacks parameterized types, so the TList class, for example, stores untyped pointers. Using interfaces, though, it is now possible to write useful, type-safe collection classes in Delphi. This article examines an interface-based set of collection classes and examines red-black trees as a specific implementation. The suite of interfaces and classes is available online at http://www.tempest-sw.com/.

Interface-Based Programming

Delphi interfaces look a lot like COM or Java interfaces. An interface describes a set of virtual methods but does not provide any storage of fields (Delphi’s term for data members or instance variables) and does not implement any methods. A class implements an interface by listing the interface name in the class declaration and implementing all of the methods of that interface. A class can implement any number of interfaces.

Like classes, an interface can inherit methods from an ancestor interface. All interfaces in Delphi inherit from a root interface, IInterface, which defines the QueryInterface, _AddRef, and _Release methods. If you are familiar with Microsoft’s COM, you will recognize these methods, but don’t let them fool you. Delphi interfaces are not tied to COM in any way. The way interfaces work is very similar to COM, but you can use interfaces for many other uses, as this article explains.

When using interfaces in Delphi, you rarely need to worry about IInterface and its methods. Most often, you will be able to derive a class from TInterfacedObject, which implements IInterface and provides useful implementations of its methods. If you must inherit from a different class, it’s easy to implement these methods.

The QueryInterface method casts an object to a different interface type. As an argument, you pass an interface identifier, and the method determines whether the object’s class implements that interface. If so, a new interface is returned; otherwise an error status is returned. The Delphi Pascal compiler automatically keeps track of which interfaces a class implements, so implementing the QueryInterface method is simply a matter of calling GetInterface, which looks up an interface identifier.

Delphi lacks automatic memory management for ordinary objects, but uses reference counting to manage the lifetimes of interfaced objects. The _AddRef method increments the object’s reference count, and _Release decrements the reference count. When the reference count becomes zero, _Release frees the object. The compiler automatically generates calls to _AddRef and _Release to track assignments of interfaces, passing interfaces to subroutines, and so on. In other words, most of Delphi’s interface handling is transparent to the programmer. To take full advantage of Delphi’s interfaces, you only need to derive a class from TInterfacedObject, and implement any or all the interfaces you want. Whenever your program uses interface references instead of object references, Delphi takes over management of the objects, and uses reference counting to know when it is safe to free them.

One of the tricks when using interfaces in Delphi is that once you cast an object reference to an interface, Delphi owns the interface and will manage its lifetime. Do not call the object’s Free method. This is different from the usual pattern of using objects in Delphi, and it takes getting used to. Delphi will free the object when it is safe to do so, that is, when there are no more references to the object.

The Collection Framework

Figure 1 shows the inheritance tree for the collection interfaces. The root interface, ICollection, defines methods that apply to all kinds of collections. To store an object in a collection, its class must implement the ICollectible interface. Thus the collection classes are not restricted to storing any particular class. If you must store objects whose classes do not implement ICollectible, the framework includes a wrapper class that holds any object and implements the ICollectible interface. Example 1 shows the declaration for the basic interfaces in the collection framework.

Derived from ICollection are several interfaces for particular kinds of collections, namely, IList, IStack, ISet, and IMap. A list is a collection where the elements are arranged in a particular sequence. The sequence is usually the order in which the objects are added to the collection. IList adds a few methods to ICollection — for indexed access to individual elements of the collection. IStack declares methods for pushing, popping, and accessing the top of the stack. A set is a collection of unique elements, but not necessarily in any particular order. A map is a set of key-value associations. IMap adds several methods for working with keys and values as distinct objects.

Enumerators examine the elements of a collection. The base interface is IEnumerator. Every collection implements the Enumerator method, which creates an instance of an enumerator. Each collection can have many enumerator instances, each with its own position in the collection. If an enumerator is active on a collection, you should not modify the collection except by using the enumerator. If you modify a collection with one enumerator, you should reset all other enumerators that are active on the same collection.

The ICollection interface declares the basic methods for accessing a collection. The design of ICollection owes much to the new collection interfaces in Java, the STL in C++, and to the collection classes in Smalltalk. Some of the more important methods are described in Table 1.

Some collection interfaces declare additional methods, which are shown in Example 1. For example, IStack has the methods Push, Pop, and Top, mentioned previously. The IList interface adds methods and a property to facilitate indexed access to the collection, where the index is an integer. IMap also allows indexed access, but the index can be any object that implements ICollectible.

Implementing the Collection Interfaces

Interfaces define behavior, and classes implement that behavior. The separation of interface and implementation facilitates object-oriented programming in Delphi. When designing a program, it’s best to think of the behavior of the objects that make up the program. What matters, for example, is that a compiler’s symbol table can store and retrieve identifiers. Whether the symbol table stores its identifiers in a tree or a hash table is not important during the early design of the compiler. Because each identifier has information associated with it; e.g., type, its declaration, and so on; a map is the appropriate choice for the collection. Armed with the IMap interface, you can design and even implement the compiler, deferring the implementation choice until the very end. Using the IMap interface is just as simple. The shallow inheritance tree means you need to learn the methods of only ICollection and IMap. The symbol table uses Add to add identifiers and FindKey to look them up.

An additional benefit of using interfaces is that Delphi handles the memory management. The compiler probably implements classes such as TVariable or TFunction and stores these objects in the symbol table. Some symbols are needed only during parsing, and others might be needed for code generation; still others stick around through optimization. You don’t need to worry about when these objects are safe to delete. Create IVariable, IFunction, and similar interfaces so you can work entirely in the world of interfaces, and let Delphi handle the ugly details. Creating an interface layer for the compiler’s classes adds only a little bit of complexity, but the gains are enormous because memory-management bugs are among the most common and the most difficult to track down.

When it’s time to give a concrete implementation to the IMap interface, you can choose hash tables, sorted arrays, or red-black trees. If none of the existing classes suit your needs, it’s easy to add new collection classes. The basic kinds of implementations are arrays, linked lists, hash tables, and red-black trees. For more information about red-black trees in general, see “Red-Black Trees,” by Bruce Schneier (Dr. Dobb’s Journal, April 1992).

Arrays are good for small collections or collections that must be kept in order and indexed randomly. Sorted arrays give good performance for smaller sets and maps, but larger ones need the better performance of a tree or hash table. The separation of interface and implementation means you can use a collection interface and change implementations without any other changes to your program.

All the collection classes inherit from TCollection. They could inherit from any other class, but TCollection implements many of the methods of ICollection, so it’s a convenient base class to use. To implement a new collection class, you need to implement only the Add, Enumerator, Find, and Remove methods. TCollection implements all the other methods in terms of those four, but some methods, such as GetCount and Clear should be overridden to improve performance. Example 2 shows the declaration of the TCollection class and the implementations of some of its more interesting methods.

The implementation class hierarchy is more complicated than the interface hierarchy. In order to maximize code reuse, the implementation classes do not always follow strict is-a relationships. This is another benefit to separating interfaces from implementations. For example, all the map implementations inherit from TMap, which implements the map behavior by storing key/value associations in a set. The concrete class that derives from TMap determines the set implementation to use. Thus, TRbTreeMap inherits its map behavior from TMap and delegates the storage to a TRbTreeSet object. Figure 2 shows the inheritance tree for the array, red-black tree, and map collections. Linked lists and hash tables are similar, but are omitted for the sake of brevity.

For very small sets, use TArraySet, and for slightly larger sets, you can use TSortedArraySet. For larger collections, hash tables and trees provide better performance. THashTable implements a generic hash table, and THashSet inherits from it to implement the ISet interface. Hash tables are fast, but store their elements in an unpredictable order. If you want to keep the elements in sorted order, the TRbTree class implements red-black trees, and TRbTreeSet implements ISet using a red-black tree.

Creating a new collection class is easy. The hardest work is implementing the logic to manage the basic collection; e.g., the hash table or the red-black tree.

Red-Black Trees

In a red-black tree, each node stores three references: a parent, a left child, and a right child. Each node also holds a reference to an ICollectible interface, which is the user’s object. A node also needs to store a color (red or black). Instead of reserving an entire integer for a single bit, The TRbNode class stores the color as the least significant bit of the parent pointer.

Tricky code is often a sign of muddled thinking, but this particular trick pays off in time and space. Storing one bit of information ordinarily requires an entire integer. Delphi has the Boolean type, which it can store in one byte, but modern architectures, such as the Pentium, prefer to fetch and store information as entire words. Therefore, Delphi and other modern compilers align fields on integer boundaries. Thus, storing a single bit ends up occupying 32 bits, thereby wasting 31 bits. Because of the same alignment restrictions, Delphi’s memory allocator aligns memory on integer boundaries. This means the least significant bits of every pointer are always set to zero.

The lowest bit of a pointer is always zero, so why not store the color there? When treating the field as a pointer, force the bit to zero; when treating the field as a color, mask off the pointer part of the field to leave only the color bit. The implementation of the Color and Parent properties is hidden in the TRbNode class, so changing from the clear, direct approach to the packed, tricky approach requires no changes to the rest of the collection package. Example 3 shows the TRbNode class. The color trick is entirely encapsulated by this class, so the bulk of the code for managing the tree (in class TRbTree) does not need to know about it.

The TRbTree class handles the logic for rotating subtrees and all the other fun stuff that makes a red-black tree what it is. Because TRbTree inherits from TCollection, it doesn’t have to do much to implement the ICollection interface. Like any other class that inherits from TCollection, TRbTree implements the Add, Enumerator, Find, and Remove methods. For performance reasons, it also overrides Clear and GetCount. You could squeeze even more performance by overriding a few other methods, such as RetainAll, but that is left as an exercise for the reader. Example 4 shows the Find and Remove methods as examples. Download the collection suite to see the implementations of the other methods.

The collection suite comes with a test program that lets you play around with the basic interfaces. You can add items, remove items, look up items, and even run a simple performance test. For red-black trees, you can pop up a window that displays the tree structure — an invaluable aid when debugging the TRbTree class. Figure 3 shows an example of the debugging window in action. Naturally, the structure of the tree is not important when using the TRbTree collection classes, but the debug window needs to get to the protected members of TRbTree. To do that, it uses another trick: derive TExposeTree from TRbTree and cast every TRbTree instance to TExposeTree. This is a dangerous trick because you are casting an object to the “wrong” type, but if you do not add any virtual methods or fields to TExposeTree, you can use this trick safely. This trick works because Delphi lets all classes that are defined in a single unit access each other’s private and protected members. TExposeTree is declared in the same unit as the debugging form, so the form class can access the protected members of TExposeTree, which it inherits from TRbTree. Example 5 shows the method that constructs the tree view representation of the red-black tree.

Conclusion

Interfaces are a powerful way to program in an object-oriented world. By separating type hierarchies as interfaces from code-reuse hierarchies as classes, you can write better programs that are easier to read and maintain. The collection framework demonstrates how easy it is to work with interfaces in Delphi. Any class can implement the ICollectible interface, so it can be stored in a collection. A collection class must implement ICollection and any one or more of the collection interfaces: IList, ISet, IStack, and IMap.

The TCollection class implements most of the methods of ICollection, so concrete collection classes are easy to implement. The suite comes with array, linked list, hash table, and red-black tree implementations of the collection interfaces. This article takes a closer look at the red-black trees. The entire suite is freely available online.

About the Author

Ray Lischner is the author of Delphi in a Nutshell (O’Reilly), plus other books and articles about Delphi. He is also a co-author of Shakespeare for Dummies, proving that literature and computers can coexist happily. You can contact him at [email protected].

Figure 1: The inheritance tree for the collection interfaces

Figure 2: The inheritance tree for the array, red-black tree, and map collections

Figure 3: The red-black tree debugging window in action

Table 1: Important methods of the ICollection interface

Example 1: The declaration for the basic interfaces in the collection framework

type
  ICollectible = interface
  ['{618977E1-1ADA-11D3-B1A8-00105AA9C2AD}']
    // Return a value < 0 if Self<Obj
    //                = 0 if Self=Obj
    //                > 0 if Self>Obj
    function CompareTo(const Obj: ICollectible): Integer;
    // Return a unique hash value. If two objects are equal (Compare=0)
    // their hash values must also be equal, but the reverse is not
    // necessarily true.
    function HashValue: THashValue;
  end;

  // For use in Maps. A Map is a Set where every member of the set
  // is an IAssociation. An assocation associates a key and a value.
  // The Map uses the key to determine set membership; the value just
  // tags along for good luck.
  IAssociation = interface
  ['{6CF8D12F-16D3-11D3-B1A8-00105AA9C2AD}']
    procedure GetKey(out Key: ICollectible);
    procedure GetValue(out Value: IUnknown);
    procedure SetValue(Value: IUnknown);
  end;

  // The array types are used by enumerators to fetch multiple items from
  // a collection. Usually, you will use the dynamic arrays, but you can
  // use the static arrays, if you prefer.
  TCollectibleArray = array of ICollectible;
  TAssociationArray = array of IAssociation;

  TStaticCollectibleArray = array[0..MaxListSize-1] of ICollectible;
  TStaticAssociationArray = array[0..MaxListSize-1] of IAssociation;

  // User-supplied function; return True to continue, False to abort.
  TCollectionProc = function (Obj: ICollectible): Boolean of object;
  TAssociationProc = function (Key: ICollectible; Value: IUnknown): 
                             Boolean of object;

  IEnumerator = interface;
  ICollection = interface
  ['{618977E3-1ADA-11D3-B1A8-00105AA9C2AD}']
    // Add one or more items to the collection.
    procedure Add(Obj: ICollectible);
    procedure AddAll(Collection: ICollection);

    // Remove all items from the collection.
    procedure Clear;

    // Make a copy of this collection. Do not copy the items in the collection,
    // but keep references to the same items.
    procedure Clone(out Collection: ICollection);

    // Return true when the collection contains the object.
    function Contains(const Obj: ICollectible): Boolean;
    // Return true if this collection contains all of the items in "Collection",
    // in any order.
    function ContainsAll(const Collection: ICollection): Boolean;

    // Count the number of items matching the given item.
    function CountMatching(const Obj: ICollectible): Integer;

    // Return a new enumerator for this collection. Do not modify the collection
    // while the enumerator is active. You can have any number of enumerators
    // for each collection.
    procedure Enumerator(out Enum: IEnumerator); overload;

    // Look for the first matching object and get a reference to the
    // object in the collection. Return True if found, False if not found.
    // Set Found to nil if not found.
    function Find(const SearchFor: ICollectible; out Found: ICollectible):
                 Boolean;

    // Call Proc for each item in the collection.
    procedure ForEach(Proc: TCollectionProc); overload;

    // Return the number of items in the collection.
    function GetCount: Integer;

    // Tell the collection how to handle duplicate items. Some collections
    // do not let you change the duplicates behavior, and will raise an
    // exception if you try to set Duplicates to an invalid value.
    function GetDuplicates: TDuplicates;
    procedure SetDuplicates(Dup: TDuplicates);

    // Return True if Count=0, False if Count>0.
    function IsEmpty: Boolean;

    // Return true if the other collection has the same contents.
    function IsEqual(const Collection: ICollection): Boolean;

    // Query the collection class and return True if:
    // IsMap: the collection is a map collection
    // IsSorted: the collection puts items into sorted order
    // IsOrdered: the collection preserves the order in which items are added
    function IsMap: Boolean;
    function IsSorted: Boolean;
    function IsOrdered: Boolean;

    // Remove the first occurence of an item from the collection.
    // Raise EItemNotFound if it is not in the collection.
    procedure Remove(const Obj: ICollectible);

    // Remove all occurences of an item from the collection.
    // Do nothing if the item is not in the collection.
    procedure RemoveAll(const Obj: ICollectible); overload;

    // Remove all occurences of all the items in Collection.
    // Raise an exception if any item is not in this collection.
    procedure RemoveAll(const Collection: ICollection); overload;

    // Remove all objects EXCEPT those in "Collection".
    procedure RetainAll(const Collection: ICollection);

    // Return a dynamic array that contains the same items as this collection.
    function ToArray: TCollectibleArray;

    property Count: Integer read GetCount;
    property Duplicates: TDuplicates read GetDuplicates write SetDuplicates;
  end;

  IEnumerator = interface
  ['{618977E4-1ADA-11D3-B1A8-00105AA9C2AD}']
    // Make a copy of this iterator, iterating over the same collection,
    // from the same position.
    procedure Clone(out Enum: IEnumerator);

    // Return True if another item is available to be retrieved by Next,
    // or False if the next call to Next will fail.
    function HasNext: Boolean;

    // Get the next item or items in the collection. Choose the dynamic array
    // or static array for returning multiple items. NumFetched tells you how
    // many items were fetched. For a dynamic array, the array size tells you
    // how many items were fetched.
    // The last forms of Next fetches at most one item, returning False
    // if no more items can be fetched.
    procedure Next(Count: Integer; out ResultArray: TCollectibleArray);
                  overload;
    procedure Next(Count: Integer; var ResultArray: 
                   TStaticCollectibleArray; var NumFetched: Integer); overload;
    function Next(out Obj: ICollectible): Boolean; overload;

    // Remove the item that was most recently fetched by Next.
    // A subsequent call to Next fetches the item immediately
    // after the item that was removed. If Next failed or was not
    // called first, Remove raises an exception.
    procedure Remove;

    // Reset the enumerator so Next will fetch the first item.
    procedure Reset;

    // Try to skip over Count items in the collection. Return the number
    // of items actually skipped.
    function Skip(Count: Integer = 1): Integer;
  end;

  // A set contains at most one occurence of an item (Duplicates = dupIgnore).
  ISet = interface(ICollection)
  ['{6CF8D136-16D3-11D3-B1A8-00105AA9C2AD}']
  end;
  IEnumSet = interface(IEnumerator)
  ['{6CF8D137-16D3-11D3-B1A8-00105AA9C2AD}']
  end;

  // A list contains items in a specific order.
  IList = interface(ICollection)
  ['{618977E5-1ADA-11D3-B1A8-00105AA9C2AD}']
    function GetItems(Index: Integer): ICollectible;
    procedure SetItems(Index: Integer; Item: ICollectible);
    function IndexOf(const Item: ICollectible): Integer;

    // A list is special and allows adding and deleting an item
    // at a specific index.
    procedure Delete(Index: Integer);
    procedure Insert(Index: Integer; Obj: ICollectible);
    procedure GetItem(Index: Integer; out Item: ICollectible);

    property Items[Index: Integer]: ICollectible read GetItems write SetItems; 
                                  default;
  end;
  IEnumList = interface(IEnumerator)
  ['{618977E6-1ADA-11D3-B1A8-00105AA9C2AD}']
  end;

  IStack = interface(ICollection)
  ['{E7A78232-1C36-11D3-B1A8-00105AA9C2AD}']
    // Get the top of stack. Return True for success, False if stack if empty.
    function GetTop(out Top: ICollectible): Boolean;
    // Add an item to the stack.
    procedure Push(Obj: ICollectible);
    // Get the top of stack and remove it.
    function Pop(out Top: ICollectible): Boolean;
  end;

  // A map stores key/value pairs. Lookup, remove, etc., by key or value.
  // Access by key is fast; access by value is possible, but requires
  // a linear search over the entire collection. The value can usually be
  // any IUnknown, but if you want to search by value, the value must
  // implement ICollectible.
  // The inherited method--Add, Contains, Find, and Remove--take associations
  // as arguments or return IAssociation objects as results.
  IEnumMap = interface;
  IMap = interface(ICollection)
  ['{6CF8D130-16D3-11D3-B1A8-00105AA9C2AD}']
    procedure Add(Assoc: IAssociation); overload;
    procedure Add(Key: ICollectible; Value: IUnknown); overload;
    procedure Enumerator(out Enum: IEnumMap); overload;
    function FindKey(const Key: ICollectible; out Assoc: IAssociation): Boolean;
    function FindValue(const Value: ICollectible; out Assoc: IAssociation): 
                     Boolean;
    procedure RemoveKey(const Key: ICollectible);
    procedure RemoveValue(const Value: ICollectible);
    function ContainsKey(const Key: ICollectible): Boolean;
    function ContainsValue(const Value: ICollectible): Boolean;

    // Call Proc for each association in the map.
    procedure ForEach(Proc: TAssociationProc); overload;

    // Get the value for a key, or raise an EItemNotFound exception.
    function GetPropValue(const Key: ICollectible): IUnknown;
    procedure SetPropValue(const Key: ICollectible; Value: IUnknown);

    // Get a value for a key, and return True if found or False if not found.
    function GetValue(const Key: ICollectible; out Value: IUnknown): Boolean;

    // Get a set of just the keys.
    procedure GetKeys(out Keys: ISet);
    // Get a collection of just the values. The values must implement
    // ICollectible.
    procedure GetValues(out Values: ICollection);

    property Value[const Key: ICollectible]: IUnknown read GetPropValue 
                                          write SetPropValue; default;
  end;

  // The inherited Next methods fetch associations, but cast as ICollectible.
  // For your convenience, you can use the additional Next methods, which
  // explicitly use IAssociation results. The NextKey methods fetch the
  // next association, but return only the key part.
  IEnumMap = interface(IEnumerator)
  ['{6CF8D131-16D3-11D3-B1A8-00105AA9C2AD}']
    procedure  Next(Count: Integer; out ResultArray: TAssociationArray); 
                                                                overload;
    procedure Next(Count: Integer; var ResultArray: TStaticAssociationArray; 
                  var NumFetched: Integer); overload;
    function Next(out Obj: IAssociation): Boolean; overload;
    function NextKey(out Obj: ICollectible): Boolean; overload;
  end;

Example 2: Declaring the TCollection class type

  // As a convenience for implementing collection classes, use TCollection
  // as an abstract base class. It implements several of the methods in a
  // generic way.
  TCollectionClass = class of TCollection;
  TCollection = class(TInterfacedObject, ICollection)
  protected
    // The following method has an inefficient implementation, so
    // derived classes should override it, if possible.
    function GetCount: Integer; virtual;

    // The default is for collections to accept duplicate members.
    // Derived classes should override the following methods if they
    // give the programmer control or do something different.
    function GetDuplicates: TDuplicates; virtual;
    procedure SetDuplicates(Dup: TDuplicates); virtual;


    procedure DuplicateError(Item: ICollectible);
    procedure ItemNotFound(Item: ICollectible);
    procedure ValueNotFound(Item: ICollectible);
    procedure IndexOutOfRange(Index: Integer);
    procedure NotImplemented(const MethodName: string);

  public
    constructor Create; virtual;

    // Derived classes must override the following four methods:
    procedure Add(Obj: ICollectible); overload; virtual; abstract;
    procedure Enumerator(out Enum: IEnumerator); overload; virtual; abstract;
    function Find(const SearchFor: ICollectible; out Found: ICollectible):
                 Boolean; virtual; abstract;
    procedure Remove(const Obj: ICollectible); virtual; abstract;

    // The following methods have inefficient implementations, so derived
    // classes should override them, if possible.
    procedure Clear; virtual;
    procedure RetainAll(const Collection: ICollection); virtual;

    // The default implementation of the following methods always returns False.
    // Override any or all of them to return True when appropriate.
    function IsMap: Boolean; virtual;
    function IsSorted: Boolean; virtual;
    function IsOrdered: Boolean; virtual;

    // The following have convenient implementations. Most derived classes
    // will not need to override these methods, but can do so if the derived
    // class has a better way of doing the same thing.
    procedure AddAll(Collection: ICollection); virtual;
    procedure Clone(out Collection: ICollection); virtual;
    function Contains(const Obj: ICollectible): Boolean; virtual;
    function ContainsAll(const Collection: ICollection): Boolean; virtual;
    function CountMatching(const Obj: ICollectible): Integer; virtual;
    procedure First(out Item: ICollectible); virtual;
    procedure ForEach(Proc: TCollectionProc); overload; virtual;
    function IsEmpty: Boolean; virtual;
    function IsEqual(const Collection: ICollection): Boolean; virtual;
    procedure RemoveAll(const Obj: ICollectible); overload; virtual;
    procedure RemoveAll(const Collection: ICollection); overload; virtual;
    function ToArray: TCollectibleArray; virtual;

    property Count: Integer read GetCount;
    property Duplicates: TDuplicates read GetDuplicates write SetDuplicates;
  end;

// Add all items from Collection to Self.
procedure TCollection.AddAll(Collection: ICollection);
var
  Enum: IEnumerator;
  Item: ICollectible;
begin
  Collection.Enumerator(Enum);
  while Enum.Next(Item) do
    Add(Item);
end;

// Delete all the items from the collection. You should usually override this
// method to use a more efficient implementation.
procedure TCollection.Clear;
var
  Item: ICollectible;
  Enum: IEnumerator;
begin
  Enumerator(Enum);
  while Enum.Next(Item) do
    Enum.Remove;
end;

// Return True if the collection contains Obj.
function TCollection.Contains(const Obj: ICollectible): Boolean;
var
  Item: ICollectible;
begin
  Result := Find(Obj, Item);
end;

// Return True if the collection contains all of the items in Collection.
function TCollection.ContainsAll(const Collection: ICollection): Boolean;
var
  Enum: IEnumerator;
  Item: ICollectible;
begin
  Result := False;
  Collection.Enumerator(Enum);
  while Enum.Next(Item) do
    if not Contains(Item) then
      Exit;

  Result := True;
end;

Example 3: The TRbNode class encapsulates the entire color trick

type
  TRbColor = (rbBlack, rbRed);
  TRbNode = class
  private
    fLeft, fRight: TRbNode;
    fItem: ICollectible;
    fParent: Integer;
    function GetParent: TRbNode;
    procedure SetParent(Parent: TRbNode);
  protected
    constructor Create(Item: ICollectible; Leaf, Parent: TRbNode; Color: 
                     TRbColor);
    function IsRed: Boolean;
    function IsBlack: Boolean;
    function GetColor: TRbColor; virtual;
    procedure SetColor(Color: TRbColor); virtual;

    property Left: TRbNode read fLeft write fLeft;
    property Right: TRbNode read fRight write fRight;
    property Item: ICollectible read fItem write fItem;
    property Color: TRbColor read GetColor write SetColor;
    property Parent: TRbNode read GetParent write SetParent;
  end;


const
  ColorMask = $00000001;
  PointerMask = $FFFFFFFE;

constructor TRbNode.Create(Item: ICollectible; Leaf, Parent: TRbNode; Color:
                         TRbColor);
begin
  inherited Create;
  fItem := Item;
  fParent := Integer(Parent);
  // Start out with color = rbBlack
  fLeft := Leaf;
  fRight := Leaf;
  Self.Color := Color;
end;

function TRbNode.GetColor: TRbColor;
begin
  if (fParent and ColorMask) <> 0 then
    Result := rbRed
  else
    Result := rbBlack;
end;

function TRbNode.GetParent: TRbNode;
begin
  Result := TRbNode(fParent and PointerMask)
end;

function TRbNode.IsBlack: Boolean;
begin
  Result := Color = rbBlack;
end;

function TRbNode.IsRed: Boolean;
begin
  Result := Color = rbRed;
end;

procedure TRbNode.SetColor(Color: TRbColor);
begin
  if Color = rbRed then
    fParent := fParent or ColorMask
  else
    fParent := fParent and PointerMask;
end;

procedure TRbNode.SetParent(Parent: TRbNode);
begin
  fParent := (fParent and ColorMask) or Integer(Parent);
end;

Example 4: The FindNode, Find, and Remove methods of the TrbTree class

function TRbTree.FindNode(const Obj: ICollectible): TRbNode;
var
  Compare: Integer;
begin
  Result := Root;
  while Result <> Leaf do
  begin
    Compare := Obj.CompareTo(Result.Item);
    if Compare < 0 then
      Result := Result.Left
    else if Compare > 0 then
      Result := Result.Right
    else
      Exit;
  end;
end;

function TRbTree.Find(const SearchFor: ICollectible; out Found: ICollectible):
                    Boolean;
var
  Node: TRbNode;
begin
  Node := FindNode(SearchFor);
  Result := Node <> Leaf;
  if Result then
    Found := Node.Item;
end;

procedure TRbTree.Remove(const Obj: ICollectible);
var
  Node: TRbNode;
begin
  Node := FindNode(Obj);
  if Node = Leaf then
    ItemNotFound(Obj)
  else
    RemoveNode(Node);
end;

Example 5: Constructing the tree view representation of the red-black tree

// Debug a red-black tree by showing the internal tree structure.
// Visibly display an image for red and black nodes. To help color-blind
// users, Red nodes have a Round icon and Black nodes have a Box icon.

// Let the debug form access protected methods and properties.
type
  TExposeTree = class(TRbTree)
  end;
  TExposeNode = class(TRbNode)
  end;

// Refresh the tree display after changing the tree.
procedure TTreeForm.RefreshTree;
  procedure WalkTree(RbNode: TRbNode; ViewNode: TTreeNode);
  var
    Item: ICollectible;
    Assoc: IAssociation;
  begin
    if RbNode <> TExposeTree(Tree).Leaf then
    begin
      // Get the string item from the node. If the collection is a map,
      // the node holds an association, and the string is the key.
      Item := TExposeNode(RbNode).Item;
      if Item.QueryInterface(IAssociation, Assoc) = S_OK then
        Assoc.GetKey(Item);
      ViewNode := TreeView.Items.AddChild(ViewNode, (Item as IString).Value);
      if TExposeNode(RbNode).IsRed then
        ViewNode.ImageIndex := 0
      else
        ViewNode.ImageIndex := 1;
      ViewNode.SelectedIndex := ViewNode.ImageIndex;

      WalkTree(TExposeNode(RbNode).Left, ViewNode);
      WalkTree(TExposeNode(RbNode).Right, ViewNode);
    end;
  end;
  
begin
  TreeView.Items.BeginUpdate;
  try
    TreeView.Items.Clear;
    WalkTree(TExposeTree(Tree).Root, nil);
    TreeView.FullExpand;
  finally
    TreeView.Items.EndUpdate;
  end;
end;

Terms of Service | Privacy Statement | Copyright © 2024 UBM Tech, All rights reserved.