Delphi中的容器類

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則是實現所見即所得設計的關鍵類，對於開發靈活強大的自定義組件來說是必不可少的。