Delphi中的容器类

作者 陈省
从Delphi 5开始VCL中增加了一个新的Contnrs单元，单元中定义了８个新的类，全部都是基于标准的TList 类。

TList 类

TList 类实际上就是一个可以存储指针的容器类，提供了一系列的方法和属性来添加，删除，重排，定位，存取和排序容器中的类，它是基于数组的机制来实现的容器，比较类似于C++中的Vector和Java中的ArrayList，TList 经常用来保存一组对象列表，基于数组实现的机制使得用下标存取容器中的对象非常快，但是随着容器中的对象的增多，插入和删除对象速度会直线下降，因此不适合频繁添加和删除对象的应用场景。下面是TList类的属性和方法说明：


属性
描述

Count: Integer;
返回列表中的项目数

Items[Index: Integer]: Pointer; default
通过以０为底的索引下标直接存取列表中的项目


 

方法
类型
描述

Add(Item: Pointer): Integer;
函数
用来向列表中添加指针

Clear;
过程
清空列表中的项目

Delete(Index: Integer);
过程
删除列表中对应索引的项目

IndexOf(Item: Pointer): Integer;
函数
返回指针在列表中的索引

Insert(Index: Integer; Item: Pointer);
过程
将一个项目插入到列表中的指定位置

Remove(Item: Pointer): Integer;
函数
从列表中删除指针


 

名称
类型
描述

Capacity: Integer;
property
可以用来获取或设定列表可以容纳的指针数目

Extract(Item: Pointer): Pointer;
function
Extract 类似于Remove 可以将指针从列表中删除，不同的是返回被删除的指针。　

Exchange(Index1, Index2: Integer);
procedure
交换列表中两个指针

First: Pointer;
function
返回链表中的第一个指针

Last: Pointer;
function
返回链表中最后一个指针

Move(CurIndex NewIndex: Integer);
procedure
将指针从当前位置移动到新的位置

Pack;
procedure
从列表中删除所有nil指针

Sort(Compare: TListSortCompare);
procedure
用来对链表中的项目进行排序，可以设定Compare参数为用户定制的排序函数


 

TObjectList 类

TObjectList 类直接从TList 类继承，可以作为对象的容器。TObjectList类定义如下： 



TObjectList = class(TList)

    ...

public

     constructor Create; overload;

     constructor Create(AOwnsObjects: Boolean); overload;

     function Add(AObject: TObject): Integer;

     function Remove(AObject: TObject): Integer;

     function IndexOf(AObject: TObject): Integer;

     function FindInstanceOf(AClass: TClass;

      AExact: Boolean = True; AStartAt: Integer = 0):

      Integer;

     procedure Insert(Index: Integer; AObject: TObject);

     property OwnsObjects: Boolean;

     property Items[Index: Integer]: TObject; default;

end;

 

不同于TList类，TObjectList类的Add, Remove, IndexOf, Insert等方法都需要传递TObject对象作为参数，由于有了编译期的强类型检查，使得TObjectList比TList更适合保存对象。此外 TObjectList对象有OwnsObjects属性。当设定为True (默认值)，同TList类不同，TObjectList对象将销毁任何从列表中删除的对象。无论是调用Delete, Remove, Clear 方法，还是释放TObjectList对象，都将销毁列表中的对象。有了TObjectList类，我们就再也不用使用循环来释放了对象。这就避免了释放链表对象时，由于忘记释放链表中的对象而导致的内存泄漏。另外要注意的是OwnsObjects属性不会影响到Extract方法，TObjectList的Extract方法行为类似于TList，只是从列表中移除对象引用，而不会销毁对象。

 

TObjectList 对象还提供了一个FindInstanceOf 函数，可以返回只有指定对象类型的对象实例在列表中的索引。如果AExact 参数为True，只有指定对象类型的对象实例会被定位，如果AExact 对象为False，AClass 的子类实例也将被定位。AStartAt 参数可以用来找到列表中的多个实例，只要每次调用FindInstanceOf 函数时，将起始索引加１，就可以定位到下一个对象，直到FindInstanceOf 返回-1。下面是代码示意：

 

var

    idx: Integer;

begin

    idx := -1;

     repeat

      idx := ObjList.FindInstanceOf(TMyObject, True, idx+1);

       if idx >= 0 then

        ...

     until(idx < 0);

end;

 

TComponentList 类

Contnrs单元中还定义了TComponentList 类，类定义如下：



TComponentList = class(TObjectList)

    ...

public

     function Add(AComponent: TComponent): Integer;

     function Remove(AComponent: TComponent): Integer;

     function IndexOf(AComponent: TComponent): Integer;

     procedure Insert(Index: Integer; AComponent: TComponent);

     property Items[Index: Integer]: TComponent; default;

end;

注意TComponentList 是从TObjectList类继承出来的，它的Add, Remove, IndexOf, Insert和 Items 方法调用都使用TComponent 类型的参数而不再是TObject类型，因此适合作为TComponent对象的容器。TComponentList 类还有一个特殊的特性，就是如果链表中的一个组件被释放的话，它将被自动的从TComponentList 链表中删除。这是利用TComponent的FreeNotification方法可以在组件被销毁时通知链表，这样链表就可以将对象引用从链表中删除的。  

TClassList 类

Contnrs单元中还定义了TClassList类，类定义如下：



TClassList = class(TList)

protected

     function GetItems(Index: Integer): TClass;

     procedure SetItems(Index: Integer; AClass: TClass);

public

     function Add(aClass: TClass): Integer;

     function Remove(aClass: TClass): Integer;

     function IndexOf(aClass: TClass): Integer;

     procedure Insert(Index: Integer; aClass: TClass);

     property Items[Index: Integer]: TClass

       read GetItems write SetItems; default;

end;

不同于前面两个类，这个类继承于TList的类只是将Add, Remove, IndexOf, Insert和Items 调用的参数从指针换成了TClass元类类型。 

TOrderedList, TStack和TQueue 类

Contnrs单元还定义了其它三个类：TOrderedList, TStack和TQueue，类型定义如下：



TOrderedList = class(TObject)

private

    FList: TList;

protected

     procedure PushItem(AItem: Pointer); virtual; abstract;

    ...

public

     function Count: Integer;

     function AtLeast(ACount: Integer): Boolean;

     procedure Push(AItem: Pointer);

     function Pop: Pointer;

     function Peek: Pointer;

end;

 

TStack = class(TOrderedList)

protected

     procedure PushItem(AItem: Pointer); override;

end;

 

TQueue = class(TOrderedList)

protected

     procedure PushItem(AItem: Pointer); override;

end;

要注意虽然TOrderedList 并不是从TList继承的，但是它在内部的实现时，使用了TList来储存指针。另外注意TOrderedList类的PushItem 过程是一个抽象过程，所以我们无法实例化 TOrderedList 类，而应该从TOrderedList继承新的类，并实现抽象的PushItem方法。TStack 和 TQueue 正是实现了PushItem抽象方法的类， 我们可以实例化TStack 和TQueue类作为后进先出的堆栈 (LIFO)和先进先出的队列(FIFO)。下面是这两个的的方法使用说明：　

·                       Count 返回列表中的项目数。

·                       AtLeast 可以用来检查链表的大小，判断当前列表中的指针数目是否大于传递的参数值，如果为True表示列表中的项目数大于传来的参数。　

·                       对于TStack类Push 方法将指针添加到链表的最后，对于TQueue类Push 方法则将指针插入到链表的开始。

·                       Pop返回链表的末端指针，并将其从链表中删除。　

·                       Peek返回链表的末端指针，但是不将其从链表中删除。　

 

TObjectStack和TObjectQueue类

Contnrs单元中最后两个类是TObjectStack和TObjectQueue类，类的定义如下：

TObjectStack = class(TStack)

public

     procedure Push(AObject: TObject);

     function Pop: TObject;

     function Peek: TObject;

end;

 

TObjectQueue = class(TQueue)

public

     procedure Push(AObject: TObject);

     function Pop: TObject;

     function Peek: TObject;

end;

这两个类只是TStack和TQueue 类的简单扩展，在链表中保存的是TObject的对象引用，而不是简单的指针。



TIntList 类

到目前为止，我们看到的容器类中保存的都是指针或者对象引用（对象引用其实也是一种指针）。

那么我们能不能在链表中保存原生类型，如Integer，Boolean或者Double等呢。下面的我们定义的类TIntList 类就可以在链表中保存整数，这里我们利用了整数和指针都占用４个字节的存储空间，所以我们可以直接将指针映射为整数。



unit IntList;

 

interface

 

uses

    Classes;

 

type

    TIntList = class(TList)

     protected

       function GetItem(Index: Integer): Integer;

       procedure SetItem(Index: Integer;

         const Value: Integer);

     public                              

       function Add(Item: Integer): Integer;

       function Extract(Item: Integer): Integer;

       function First: Integer;

       function IndexOf(Item: Integer): Integer;

       procedure Insert(Index, Item: Integer);

       function Last: Integer;

       function Remove(Item: Integer): Integer;

       procedure Sort;

       property Items[Index: Integer]: Integer

         read GetItem write SetItem; default;

     end;

 

implementation

 

{ TIntList }

function TIntList.Add(Item: Integer): Integer;

begin

    Result := inherited Add(Pointer(Item));

end;

 

function TIntList.Extract(Item: Integer): Integer;

begin

    Result := Integer(inherited Extract(Pointer(Item)));

end;

 

function TIntList.First: Integer;

begin

    Result := Integer(inherited First);

end;

 

function TIntList.GetItem(Index: Integer): Integer;

begin

    Result := Integer(inherited Items[Index]);

end;

 

function TIntList.IndexOf(Item: Integer): Integer;

begin

    Result := inherited IndexOf(Pointer(Item));

end;

 

procedure TIntList.Insert(Index, Item: Integer);

begin

     inherited Insert(Index, Pointer(Item));

end;

 

function TIntList.Last: Integer;

begin

    Result := Integer(inherited Last);

end;

 

function TIntList.Remove(Item: Integer): Integer;

begin

    Result := inherited Remove(Pointer(Item));

end;

 

procedure TIntList.SetItem(Index: Integer;

     const Value: Integer);

begin

     inherited Items[Index] := Pointer(Value);

end;

 

function IntListCompare(Item1, Item2: Pointer): Integer;

begin

     if Integer(Item1) < Integer(Item2) then

      Result := -1

     else if Integer(Item1) > Integer(Item2) then

      Result := 1

     else

      Result := 0;

end;                        

 

procedure TIntList.Sort;

begin

     inherited Sort(IntListCompare);

end;

 

end.



扩展TList，限制类型的对象列表 

Begin Listing Two - TMyObjectList

TMyObject = class(TObject)

public

     procedure DoSomething;

end;

 

TMyObjectList = class(TObjectList)

protected

     function GetItems(Index: Integer): TMyObject;

     procedure SetItems(Index: Integer; AMyObject: TMyObject);

public

     function Add(aMyObject: TMyObject): Integer;

     procedure DoSomething;

     function Remove(aMyObject: TMyObject): Integer;

     function IndexOf(aMyObject: TMyObject): Integer;

     procedure Insert(Index: Integer; aMyObject: TMyObject);

     property Items[Index: Integer]: TMyObject

       read GetItems write SetItems; default;

end;

...

{ TMyObjectList }

function TMyObjectList.Add(AMyObject: TMyObject): Integer;

begin

    Result := inherited Add(AMyObject);

end;

 

procedure TMyObjectList.DoSomething;

var

    i: Integer;

begin

     for i := 0 to Count-1 do

      Items[i].DoSomething;

end;

 

function TMyObjectList.GetItems(Index: Integer): TMyObject;

begin

    Result := TMyObject(inherited Items[Index]);

end;

 

function TMyObjectList.IndexOf(AMyObject: TMyObject):

    Integer;

begin

    Result := inherited IndexOf(AMyObject);

end;

 

procedure TMyObjectList.Insert(Index: Integer;

    AMyObject: TMyObject);

begin

     inherited Insert(Index, AMyObject);

end;

 

function TMyObjectList.Remove(AMyObject: TMyObject):

    Integer;

begin

    Result := inherited Remove(AMyObject);

end;

 

procedure TMyObjectList.SetItems(Index: Integer;

    AMyObject: TMyObject);

begin

     inherited Items[Index] := AMyObject;

end;

End Listing Two


TStrings类



出于效率的考虑，Delphi并没有象C++和Java那样将字符串定义为类，因此TList本身不能直接存储字符串，而字符串列表又是使用非常广泛的，为此Borland提供了TStrings类作为存储字符串的基类，应该说是它除了TList类之外另外一个最重要的Delphi容器类。



要注意的是TStrings类本身包含了很多抽象的纯虚的方法，因此不能实例化后直接使用，必须从TStrings类继承一个基类实现所有的抽象的纯虚方法来进行实际的字符串列表管理。虽然TStrings类本身是一个抽象类，但是它应该说是一个使用了Template模式的模版类，提供了很多事先定义好的算法来实现添加添加、删除列表中的字符串，按下标存取列表中的字符串，对列表中的字符串进行排序，将字符串保存到流中。将每个字符串同一个对象关联起来，提供了键-值对的关联等等。



因为TStrings类本身是个抽象类，无法实例化，因此Delphi提供了一个TStringList的TStrings的子类提供了TStrings类的默认实现，通常在实际使用中，我们都应该使用TStringList类存储字符串列表，代码示意如下：



var   TempList: TStrings;     

begin

   TempList := TStringList.Create;

   try   

TempList.Add(‘字符串1’);

…

   finally   

TempList.Free;     

   end;

end;



TStrings类的应用非常广泛，很多VCL类的属性都是TStrings类型，比如TMemo组件的Lines属性，TListBox的Items属性等等。下面将介绍一下TStrings类的常见用法。



TStrings类的常见的用法



根据下标存取列表中的字符串是最常见的一种操作，用法示意如下：

StringList1.Strings[0] := '字符串1';

注意在Delphi中，几乎所有的列表的下标都是以0为底的，也就是说Strings[0]是列表中的第一个字符串。另外，由于Strings属性是字符串列表类的默认属性，因此可以省略Strings，直接用下面的简便方法存取字符串：

StringList1[0] := '字符串1';



定位一个列表中特定的字符串的位置，可以使用IndexOf方法，IndexOf方法将会返回在字符串列表中的第一个匹配的字符串的索引值，如果没有匹配的字符串则返回-1。比如我们可以使用IndexOf方法来察看特定文件是否存在于文件列表框中，代码示意如下：



if FileListBox1.Items.IndexOf('TargetFileName') > -1 ...



有一点不方便的是TStrings类没有提供一个方法可以查找除了第一个匹配字符串外其他同样匹配的字符串的索引，只能是自己遍历字符串列表来实现，这点不如C++中的模版容器类以及相关的模版算法强大和方便。下面是一个遍历字符串列表的示意，代码遍历列表框中的所有字符串，并将其全部转化为大写的字符串：



procedure TForm1.Button1Click(Sender: TObject);var   Index: Integer;

begin

   for Index := 0 to ListBox1.Items.Count - 1 do   

ListBox1.Items[Index] := UpperCase(ListBox1.Items[Index]);

end;



前面我们看到了，要想向字符串列表中添加字符串，直接使用Add方法就可以了，但是Add方法只能将字符串加入到列表的末尾，要想在列表的指定位置添加字符串，需要使用Insert方法，下面代码在列表的索引为2的位置添加了字符串：



StringList1.Insert(2, 'Three');



如果要想将一个字符串列表中的所有字符串都添加到另一个字符串列表中，可以使用AddStrings方法，用法如下:

StringList1.AddStrings(StringList2); 



要想克隆一个字符串列表的所有内容，可以使用Assign方法，例如下面的方法将Combox1中的字符串列表复制到了Memo1中：

Memo1.Lines.Assign(ComboBox1.Items);

要注意的是使用了Assign方法后，目标字符串列表中原有的字符串会全部丢失。



同对象关联



前面说了我们可以将字符串同对象绑定起来，我们可以使用AddObject或者InsertObject方法向列表添加同字符串关联的对象，也可以通过 Objects属性直接将对象同特定位置的字符串关联。此外TStrings类还提供了IndexOfObject方法返回指定对象的索引，同样的 Delete,Clear和Move等方法也可以作用于对象。不过要注意的是我们不能向字符串中添加一个没有同字符串关联的对象。



同视图交互



刚刚学习使用Delphi的人都会为Delphi IDE的强大的界面交互设计功能所震惊，比如我们在窗体上放上一个ListBox，然后在object Inspector中双击它的Items属性（TStrings类型），在弹出的对话框中，见下图，我们输入一些字符串后，点击确定，关闭对话框，就会看到窗体上的ListBox中出现了我们刚才输入的字符串。



可以我们在TStrings和默认的实现类TStringList的源代码中却找不到同ListBox相关的代码，那么这种界面交互是如何做到的呢？



秘密就在于TListBox的Items属性类型实际上是TStrings的基类TListBoxStrings类，我们看一下这个类的定义：



   TListBoxStrings = class(TStrings)

   private

     ListBox: TCustomListBox;

   protected

…

   public

     function Add(const S: string): Integer; override;

     procedure Clear; override;

     procedure Delete(Index: Integer); override;

     procedure Exchange(Index1, Index2: Integer); override;

     function IndexOf(const S: string): Integer; override;

     procedure Insert(Index: Integer; const S: string); override;

     procedure Move(CurIndex, NewIndex: Integer); override;

   end;

可以看到TListBoxStrings类实现了TStrings类的所有抽象方法，同时在内部有一个ListBox的私有变量。我们再看一下TListBoxStrings的Add方法：

function TListBoxStrings.Add(const S: string): Integer;
begin
   Result := -1;
   if ListBox.Style in [lbVirtual, lbVirtualOwnerDraw] then exit;
   Result := SendMessage(ListBox.Handle, LB_ADDSTRING, 0, Longint(PChar(S)));
   if Result < 0 then raise EOutOfResources.Create(SInsertLineError);
end;


可以看到TListBoxStrings在内部并没有保存添加的字符串，而是直接向Windows的原生列表盒控件发送消息实现的代码添加，而 Windows的原生列表盒是一个MVC的组件，当内部的数据发生变化时，会自动改变视图显示，这就是为什么我们在设计器中输入的字符串会立刻显示在窗体列表框中的原因了。



于是我们也就知道为什么Borland将TStrings设计为一个抽象的类而没有提供一个默认的存储方式，就是因为很多的界面组件在内部对数据的存储有很多不同的方式，Borland决定针对不同的组件提供不同的存储和交互方式。同样的我们要编写的组件如果有TStrings类型的属性，同时也要同界面或者其它资源交互的话，不要使用TStringList来实现，而应该从TStrings派生出新类来实现更好的交互设计。



还有一点要说明的是，Delphi的IDE只在使用Delphi的流机制保存组件到窗体设计文件DFM文件中的时，做了一些特殊的处理，能够自动保存和加载Published的TStrings类型的属性，下面就是一个ListBox储存在窗体设计文件DFM中文本形式示意(在窗体设计阶段，我们可以直接使用View As Text右键菜单命令看到下面的文本)，我们可以注意到在设计时我们输入的Items的两个字符串被保存了起来：



   object ListBox1: TListBox

     Left = 64

     Top = 40

     Width = 145

     Height = 73

     ItemHeight = 16

     Items.Strings = (

       'String1'

       'String2')

     TabOrder = 1

   end

随后如果运行程序时，VCL库会使用流从编译进可执行文件的DFM资源中将Items.Strings列表加载到界面上，这样就实现了设计是什么样，运行时也是什么样的所见即所得。



键-值对



在实际开发过程中，我们经常会碰到类似于字典的定位操作的通过键查找相应值的操作，比如通过用户名查找用户相应的登陆密码等。在C++和Java中，标准模版库和JDK都提供了Map类来实现键-值机制，但是Delphi的VCL库却没有提供这样的类，但是TStrings类提供了一个简易的Map替代的实现，那就是Name-Value对。



对于TStrings来说，所谓的Name-Value对，实际上就是’Key=Value’这样包含＝号的分割的字符串，等号左边的部分就是Name，等号右边的部分就是Value。TStrings类提供了IndexOfName和Values等属性方法来操作Name-Value对。下面是用法示意：



var

   StringList1:TStrings;

Begin

   StringList1:=TStringList.Create;

   //添加用户名-密码对

   StringList1.Add(‘hubdog=aaa’);

   StringList1.Add(‘hubcat=bbb’);

   ….

   //根据用户名hubdog查找密码

   Showmessage(StringList1.Values[StringList1.IndexOfName(‘hubdog’)]);

End;



从Delphi7开始，TStrings类增加了一个NameValueSeparator属性，我们可以通过这个属性修改默认的Name-Value分割符号为=号以外的其它符号了。还要说明的是，TStrings的Name-Value对中的Name可以不唯一，这有点类似于C++中的 MultiMap，这时通过Values[Names[IndexOfName]]下标操作取到的值不一定是我们所需要的，另外TStrings类的 Name-Value对的查找定位是采用的遍历的方式，而不同于Java和C++中的Map是基于哈希表或者树的实现，因此查找和定位的效率非常低，不适用于性能要求非常高的场景。不过从Delphi6开始,VCL库中在IniFiles单元中提供了一个基于哈希表的字符串列表类 THashedStringList类可以极大的提高查找定位的速度。



THashedStringList类



一般来说，通过键来查找值最简单的办法是遍历列表对列表中的键进行比较，如果相等则获取相应的键值。但是这种简单的办法也是效率最差的一种办法，当列表中的项目比较少时，这种办法还可以接受，但是如果列表中项目非常多的话，这种方法会极大的影响软件的运行速度。这时我们可以使用哈希表来快速的通过键值来存取列表中的元素。由于本书并不是一本数据结构和算法的书，因此我无意在这里讨论哈希表背后的理论知识，我们只要知道哈希可以通过键快速定位相应的值就可以了，对此感兴趣的非计算机专业的人可以去察看相关的书，这里就不赘述了。



Delphi6中提供的THashedStringList类没有提供任何的新的方法，只是对IndexOf和IndexOfName函数通过哈希表进行了性能优化，下面这个例子演示了TStringList和THashedStringList之间的性能差异：


unit CHash;
interface
uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls, Inifiles;

type
   TForm1 = class(TForm)
     Button1: TButton;
     procedure Button1Click(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
   private
     { Private declarations }
     HashedList: THashedStringList;
     DesList: TStringList;
     List: TStringList;
   public
     { Public declarations }
     procedure Hash;
     procedure Iterate;
   end;

var
   Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
   I:Integer;
begin
   Screen.Cursor := crHourGlass;
   try
//初始化系统
     for I := 0 to 5000 do
     begin
       HashedList.Add(IntToStr(i));
       List.Add(IntToStr(i));
     end;
     Hash;
     DesList.Clear;
     Iterate;
   finally
     Screen.Cursor := crDefault;
   end;
end;

procedure TForm1.Hash;
var
   I, J: Integer;
begin
   //基于哈希表的定位
   for I := 3000 to 4000 do
   begin
     DesList.Add(IntToStr(HashedList.IndexOf(IntToStr(I))));
   end;
end;

procedure TForm1.Iterate;
var
   I, J: Integer;
begin
   //基于遍历方式定位
   for I := 3000 to 4000 do
   begin
     DesList.Add(IntToStr(List.IndexOf(IntToStr(I))));
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   HashedList := THashedStringList.Create;
   DesList := TStringList.Create;
   List := TStringList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
   HashedList.Free;
   DesList.Free;
   List.Free;
end;

end.

上面代码中的Hash过程，采用了新的THashedStringList类来实现的查找，而Iterate过程中使用了原来的TStringList类的IndexOfName来实现的查找。采用GpProfile（注：GpProfile的用法参见工具篇的性能分析工具GpProfile章节）对两个过程进行了性能比较后，从下图可以看到Hash执行同样查找动作只用了0.7%的时间，而Iterate方法则用了99.3%的时间，可以看到在字符串列表项目数在几千的数量级别时，基于哈希表的查询速度是原有方法的100多倍。



不过要说明的是，THashedStringList同TStringList类相比，虽然查找的速度大大提高了，但是在添加、删除字符串后再次进行查找操作时，需要重新计算哈希函数，所以如果频繁的进行删除或者添加同查找的复合操作，执行的速度很有可能比TStringList还要慢，这是使用时需要注意的。



TBucketList和TObjectBucketList类



从Delphi6开始，VCL的Contnrs单元中又增加了两个新的容器类TBucketList和TObjectBucketList。TBucketList实际上也是一个简单基于哈希表的指针-指针对列表。接口定义如下：



   TBucketList = class(TCustomBucketList)

…

   public

     destructor Destroy; override;

     procedure Clear;

     function Add(AItem, AData: Pointer): Pointer;

     function Remove(AItem: Pointer): Pointer;

     function ForEach(AProc: TBucketProc; AInfo: Pointer = nil): Boolean;

     procedure Assign(AList: TCustomBucketList);

     function Exists(AItem: Pointer): Boolean;

     function Find(AItem: Pointer; out AData: Pointer): Boolean;

     property Data[AItem: Pointer]: Pointer read GetData write SetData; default;

   end;



类的Add方法现在接受两个参数AItem和AData，我们可以把它看成是指针版的Map实现（从容器类来看, Delphi从语言的灵活性来说不如C++，为了实现不同类型的哈希Map容器，Delphi需要派生很多的类，而C++的Map是基于模版技术来实现的，容器元素的类型只要简单的声明一下就能指定了，使用起来非常方便。而从简单性来说，则不如Java的容器类，因为Delphi中的String是原生类型，而不是类，并且Delphi还提供对指针的支持，因此要为指针和字符串提供不同的Map派生类），类中的Exists和Find等方法都是通过哈希表来实现快速数据定位的。同时,同一般的列表容器类不同，TBucketList不提供通过整数下标获取列表中的元素的功能，不过我们可以使用 ForEach方法来遍历容器内的元素。



TObjectBucketList是从TBucketList派生的基类，没有增加任何新的功能，唯一的不同之处就是容器内的元素不是指针而是对象了，实现了更强的类型检查而已。



其它容器类



TThreadList类



TThreadList类实际上就是一个线程安全的TList类，每次添加或者删除容易中指针时，TThreadList会调用 EnterCriticalSection函数进入线程阻塞状态，这时其它后续发生的对列表的操作都会阻塞在那里，直到TThreadList调用 UnLockList释放对列表的控制后才会被依次执行。在多线程开发中，我们需要使用TThreadList来保存共享的资源以避免多线程造成的混乱和冲突。还要注意的是TThreadList有一个Duplicates布尔属性，默认为True，表示列表中不能有重复的指针。设定为False将允许容器内有重复的元素。



TInterfaceList类



在Classes单元中，VCL还定义了一个可以保存接口的列表类。我们可以向列表中添加接口类型，这个类的操作方法同其它的列表类没有什么区别，只不过在内部使用TThreadList作为容器实现了线程安全。



拟容器类TBits类



在Classes.pas还有一个特殊的TBits类，接口定义如下：

   TBits = class

…

   public

     destructor Destroy; override;

     function OpenBit: Integer;

     property Bits[Index: Integer]: Boolean read GetBit write SetBit; default;

     property Size: Integer read FSize write SetSize;

   end;



它可以按位储存布尔值，因此可以看成是一个原生的Boolean值的容器类，但是它缺少列表类的很多方法和特性，不能算是一个完整的容器，因此我们称它为拟容器类。



在我们开发过程中，经常需要表示一些类似于开关的二元状态，这时我们用TBits来表示一组二元状态非常方便，同时TBits类的成员函数主要是用汇编语言写的，位操作的速度非常快。二元状态组的大小通过设定TBits类的Size属性来动态的调整，存取Boolean值可以通过下标来存取TBits类的 Bits属性来实现。至于OpenBit函数，它返回第一个不为True的Boolean值的下标。从接口定义可以看出，TBits类接口非常简单，提供的功能也很有限，我猜测这只是Borland的研发队伍满足内部开发有限需要的类，并不是作为一个通用类来设计的，比如它没有开放内部数据存取的接口，无法获得内部数据的表达，进而无法实现对状态的保存和加载等更高的需求。



TCollection类



前面我们提到了Delphi的IDE能够自动将字符串列表保存在DFM文件中，并能在运行时将设计期编辑的字符串列表加载进内存（也就是我们通常所说的类的可持续性）。TStrings这种特性比较适合于保存一个对象同多个字符串数据之间关联，比较类似于现实生活中一个人同多个Email账户地址之间的关系。但是，TStrings类型的属性有一个很大的局限那就是，它只能用于设计时保存简单的字符串列表，而不能保存复杂对象列表。而一个父对象同多个子对象之间的聚合关系可能更为常见，比如一列火车可能有好多节车厢构成，每节车厢都有车厢号，车厢类型（卧铺，还是硬座），车厢座位数，车厢服务员名称等属性构成。如果我们想在设计期实现对火车的车厢定制的功能，并能保存车厢的各个属性到窗体文件中，则车厢集合属性定义为TStrings类型的属性是行不通的。



对于这个问题，Delphi提供了TCollection容器类属性这样一个解决方案。TCollection以及它的容器元素TCollectionItem的接口定义如下：

   TCollection = class(TPersistent)
   …
   protected
     procedure Added(var Item: TCollectionItem); virtual; deprecated;
     procedure Deleting(Item: TCollectionItem); virtual; deprecated;
     property NextID: Integer read FNextID;
     procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); virtual;
     { Design-time editor support }
     function GetAttrCount: Integer; dynamic;
     function GetAttr(Index: Integer): string; dynamic;
     function GetItemAttr(Index, ItemIndex: Integer): string; dynamic;
     procedure Changed;
     function GetItem(Index: Integer): TCollectionItem;
     procedure SetItem(Index: Integer; Value: TCollectionItem);
     procedure SetItemName(Item: TCollectionItem); virtual;
     procedure Update(Item: TCollectionItem); virtual;
     property PropName: string read GetPropName write FPropName;
     property UpdateCount: Integer read FUpdateCount;
   public
     constructor Create(ItemClass: TCollectionItemClass);
     destructor Destroy; override;
     function Owner: TPersistent;
     function Add: TCollectionItem;
     procedure Assign(Source: TPersistent); override;
     procedure BeginUpdate; virtual;
     procedure Clear;
     procedure Delete(Index: Integer);
     procedure EndUpdate; virtual;
     function FindItemID(ID: Integer): TCollectionItem;
     function GetNamePath: string; override;
     function Insert(Index: Integer): TCollectionItem;
     property Count: Integer read GetCount;
     property ItemClass: TCollectionItemClass read FItemClass;
     property Items[Index: Integer]: TCollectionItem read GetItem write SetItem;
   end;


   TCollectionItem = class(TPersistent)
…
   protected
     procedure Changed(AllItems: Boolean);
     function GetOwner: TPersistent; override;
     function GetDisplayName: string; virtual;
     procedure SetCollection(Value: TCollection); virtual;
     procedure SetIndex(Value: Integer); virtual;
     procedure SetDisplayName(const Value: string); virtual;
   public
     constructor Create(Collection: TCollection); virtual;
     destructor Destroy; override;
     function GetNamePath: string; override;
     property Collection: TCollection read FCollection write SetCollection;
     property ID: Integer read FID;
     property Index: Integer read GetIndex write SetIndex;
     property DisplayName: string read GetDisplayName write SetDisplayName;
   end;


TCollection类是一个比较复杂特殊的容器类。但是初看上去，它就是一个TCollectionItem对象的容器类，同列表类TList类似，TCollection类也维护一个TCollectionItem对象索引数组，Count属性表示容器中包含的TCollectionItem的数目，同时也提供了Add和Delete方法来添加和删除TCollectionItem对象以及通过下标存取TCollectionItem的属性。看上去和容器类区别不大，但是在VCL内部用于保存和加载组件的TReader和TWriter类提供了两个特殊的方法WriteCollection和 ReadCollection用于加载和保存TCollection类型的集合属性。IDE就是通过这两个方法实现对TCollection类型属性的可持续性。



假设现在需要设计一个火车组件TTrain，TTrain组件有一个TCollection类型的属性Carriages表示多节车厢构成的集合属性，每个车厢则对应于集合属性的元素，从TCollectionItem类继承，有车厢号，车厢类型（卧铺，还是硬座），车厢座位数，车厢服务员名称等属性，下面是我设计的组件的接口：



type
   //车厢类型，硬座、卧铺
   TCarriageType = (ctHard, ctSleeper);
   //车厢类
   TCarriageCollectionItem = class(TCollectionItem)
…
   published
     //车厢号码
property CarriageNum: Integer read FCarriageNum write FCarriageNum;
//座位数
property SeatCount: Integer read FSeatCount write FSeatCount;
//车厢类型
property CarriageType: TCarriageType read FCarriageType write FCarriageType;
//服务员名称
     property ServerName: string read FServerName write FServerName;
   end;

   TTrain=class;
   //车厢容器属性类 
   TCarriageCollection = class(TCollection)
   private
     FTrain:TTrain;
     function GetItem(Index: Integer): TCarriageCollectionItem;
     procedure SetItem(Index: Integer;   const Value: TCarriageCollectionItem);
   protected
     function GetOwner: TPersistent; override;
   public
     constructor Create(ATrain: TTrain);
     function Add: TCarriageCollectionItem;
property Items[Index: Integer]: TCarriageCollectionItem read GetItem
write SetItem; default;
   end;
 
   //火车类
   TTrain = class(TComponent)
   private
     FItems: TCarriageCollection;
     procedure SetItems(Value: TCarriageCollection);
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
   published
     property Carriages: TCarriageCollection   read FItems write SetItems;
   end;


其中车厢类的定义非常简单，只是定义了四个属性。而车厢集合类重定义了静态的Add方法以及Items属性，其返回结果类型改为了TCarriageCollectionItem，下面是车厢集合类的实现代码：



function TCarriageCollection.Add: TCarriageCollectionItem;

begin

   Result:=TCarriageCollectionItem(inherited Add);

end;



constructor TCarriageCollection.Create(ATrain: TTrain);

begin

   inherited Create(TCarriageCollectionItem);

   FTrain:=ATrain;

end;



function TCarriageCollection.GetItem(

   Index: Integer): TCarriageCollectionItem;

begin

   Result := TCarriageCollectionItem(inherited GetItem(Index));

end;



function TCarriageCollection.GetOwner: TPersistent;

begin

   Result:=FTrain;

end;



procedure TCarriageCollection.SetItem(Index: Integer;

   const Value: TCarriageCollectionItem);

begin

   inherited SetItem(Index, Value);

end;



其中Add,GetItem和SetItem都非常简单，就是调用基类的方法，然后将基类的方法的返回结果重新映射为TCollectionItem类型。而构造函数中将TTrain组件作为父组件传入，并重载GetOwner方法，返回TTrain组件，这样处理的原因是IDE会在保存集合属性时调用集合类的GetOwner确认属性的父控件是谁，这样才能把集合属性写到DFM文件中时，才能存放到正确的位置下面，建立正确的聚合关系。



而火车组件的实现也非常简单，只要定义一个Published Carriages属性就可以了，方法实现代码如下：



constructor TTrain.Create(AOwner: TComponent);

begin

   inherited;

   FItems := TCarriageCollection.Create(Self);

end;



destructor TTrain.Destroy;

begin

   FItems.Free;

   inherited;

end;



procedure TTrain.SetItems(Value: TCarriageCollection);

begin

   FItems.Assign(Value);

end;



下面将我们的组件注册到系统面板上之后，就可以在窗体上放上一个TTrain组件，然后然后选中Object Inspector，然后双击Carriages属性，会显示系统默认的集合属性编辑器，使用Add按钮向列表中添加两个车厢，修改一下属性，如下图所示意：







从上面的属性编辑器我们，可以看到默认情况下，属性编辑器列表框是按项目索引加上一个横杠来显示车厢的名称，看起来不是很自然。要想修改显示字符串，需要重载TCarriageCollectionItem的GetDisplayName方法。修改后的GetDisplayName方法显示车厢加车厢号码：



function TCarriageCollectionItem.GetDisplayName: string;

begin

   Result:='车厢'+IntToStr(CarriageNum);

end;



示意图：





保存一下文件，使用View As Text右键菜单命令察看一下DFM文件，我们会看到我们设计的车厢类的属性确实都被写到了DFM文件中，并且Carriages属性的父亲就是Train1：



   object Train1: TTrain

     Carriages = <

       item

         CarriageNum = 1

         SeatCount = 100

         CarriageType = ctHard

         ServerName = '陈省'

       end

       item

         CarriageNum = 2

         SeatCount = 200

         CarriageType = ctHard

         ServerName = 'hubdog'

       end>

     Left = 16

     Top = 8

   End



TOwnedCollection

从Delphi4开始，VCL增加了一个TOwnedCollection类，它是TCollection类的子类，如果我们的 TCarriageCollection类是从TOwnedCollection类继承的，这时我们就不再需要向上面重载GetOwner方法并返回父控件给IDE，以便TCarriageCollection属性能出现在Object Inspector中了。



总结



本章中我介绍了几乎所有VCL中重要的容器类，其中TList及其子类相当于通用的容器类，虽然不如C++和Java功能那么强大，但是用好了已经足以满足我们90%的开发需要，而TStrings及其子类，还有TCollection则是实现所见即所得设计的关键类，对于开发灵活强大的自定义组件来说是必不可少的。