Object Pascal Containers

Object Pascal 的自由軟體實作 Free Pascal 目前有幾個通用的 containers 實作：

• Generics.Collections (since FPC >= 3.2.0)
• FGL unit
• GVector unit (together in fcl-stl)

一般而言建議使用 Generics.Collections，因為相容於 Delphi 與 Free Pascal。 Generis.Collections 單元中最重要的類別有：

• TList
  A generic list of types.
• TObjectList
  A generic list of object instances. It can "own" children, which means that it will free them automatically.
• TDictionary
  A generic dictionary.
• TObjectDictionary
  A generic dictionary, that can "own" the keys and/or values.

下面是 TList 的例子。

{$ifdef FPC} {$mode delphi} {$endif}
{$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif}

program demo;

uses
  Generics.Collections,
  SysUtils;

var
  MyList: TList<string>;
  S: string;

begin
  MyList := TList<string>.Create;
  try
    MyList.Add('Apple');
    MyList.Add('Banana');
    MyList.Add('Cherry');

    writeln('Items in the list:');
    for S in MyList do
      writeln(S);

    writeln('First item: ' + MyList[0]);

  finally
    MyList.Free;
  end;
end.

下面是電腦猜數字的小遊戲：

{$ifdef FPC} {$mode delphi} {$endif}
{$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif}

program guessAB;

uses Generics.Collections, SysUtils;

(*
 * function getA: to get a value
 *)
function getA(myguess: string; myanswer: string): Integer;

var 
  len1, len2, index, count: Integer;
begin
  count := 0;
  len1 := Length(myguess);
  len2 := Length(myanswer);

  if (len1 <> len2) then
    Exit(0);

  for index := 1 to len1 do
    begin
      if (myguess[index] = myanswer[index]) then
        count := count + 1;
    end;

  result := count;
end;

(*
 * function getB: to get b value
 *)
function getB(myguess: string; myanswer: string): Integer;

var 
  len1, len2, index1, index2, count: Integer;
begin
  count := 0;
  len1 := Length(myguess);
  len2 := Length(myanswer);

  if (len1 <> len2) then
    Exit(0);

  for index1 := 1 to len1 do
    begin
      for index2 := 1 to len2 do
        begin
          if (index1 <> index2) then
            begin
              if (myguess[index1] = myanswer[index2]) then
                count := count + 1;
            end;
        end;
    end;

  result := count;
end;

(*
 * procedure genSolutions: to generate solutions
 *)
procedure genSolutions(var solutions: TList<string>);

var
  i, j, k, m : integer;
  tempstring : string;
begin
  for i := 0 to 9 do
  begin
    for j := 0 to 9 do
    begin
      for k := 0 to 9 do
      begin
        for m := 0 to 9 do
        begin
          if (i <> j) and (i <> k) and (i <> m) and
                     (j <> k) and (j <> m) and (k <> m) then
          begin
            tempstring := IntToStr(i) + IntToStr(j) +
                                    IntToStr(k) + IntToStr(m);
            solutions.Add(tempstring);
          end;
        end;
      end;
    end;
  end;
end;

var   
  index : Integer;
  avalue, bvalue : integer;
  aguess, bguess : integer;
  myanswer : string[4];
  total : TList<string>;

(*
 * main procedure
 *)
begin
  total := TList<string>.Create;
  genSolutions(total);

  while True do
    begin
      if (total.Count = 0) then
        begin
          WriteLn('Something is wrong.');
          break;
        end;

      myanswer := total[total.Count - 1];
      WriteLn('My answer is ', myanswer, '.');

      Write('The a value is: ');
      ReadLn(avalue);
      Write('The b value is: ');
      ReadLn(bvalue);

      if (avalue = 4) and (bvalue = 0) then
        begin
          WriteLn('Game is completed.');
          break;
        end;

      for index := total.Count - 1 downto 0 do
        begin
          aguess := getA(total[index], myanswer);
          bguess := getB(total[index], myanswer);

          if (aguess <> avalue) or (bguess <> bvalue) then
              total.Delete(index);
        end;

      WriteLn();
    end;

    total.Free;
end.

下面是 TObjectList 的例子。

{$ifdef FPC} {$mode delphi} {$endif}
{$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif}

program Apples;

uses SysUtils, Generics.Collections;

type
  TApple = class
    Name: string;
  end;

  TAppleList = TObjectList<TApple>;

var
  A: TApple;
  Apples: TAppleList;

begin
  Apples := TAppleList.Create(true);
  try
    A := TApple.Create;
    A.Name := 'my apple';
    Apples.Add(A);

    A := TApple.Create;
    A.Name := 'another apple';
    Apples.Add(A);

    Writeln('Count: ', Apples.Count);
    Writeln(Apples[0].Name);
    Writeln(Apples[1].Name);
  finally
    FreeAndNil(Apples)
  end;
end.

請注意，某些操作需要比較兩個項目，例如排序和搜尋（例如，透過 Sort 和 IndexOf 方法）。 Generics.Collections 使用 comparer 來實現這一點。預設 comparer 適用於所有類型， 甚至適用於記錄（在這種情況下，它會比較記憶體內容，至少對於使用 IndexOf 進行搜尋而言，這是一個合理的預設值）。

{$ifdef FPC} {$mode delphi} {$endif}
{$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif}

program Apples;

uses SysUtils, Generics.Defaults, Generics.Collections;

type
  TApple = class
    Name: string;
  end;

  TAppleList = TObjectList<TApple>;

function CompareApples(constref Left, Right: TApple): Integer;
begin
  Result := AnsiCompareStr(Left.Name, Right.Name);
end;

type
  TAppleComparer = TComparer<TApple>;

var
  A: TApple;
  L: TAppleList;

begin
  L := TAppleList.Create(true);
  try
    A := TApple.Create;
    A.Name := '11';
    L.Add(A);

    A := TApple.Create;
    A.Name := '33';
    L.Add(A);

    A := TApple.Create;
    A.Name := '22';
    L.Add(A);

    L.Sort(TAppleComparer.Construct({$ifdef FPC}@{$endif} CompareApples));

    Writeln('Count: ', L.Count);
    Writeln(L[0].Name);
    Writeln(L[1].Name);
    Writeln(L[2].Name);
  finally
    FreeAndNil(L)
  end;
end.

參考連結

• Modern Object Pascal Introduction for Programmers
• Generics