现在准备建立 Items 数组属性; 在 public 区输入下面代码:
property Items[Index: Integer]: Pointer;

执行 Shift+Ctrl+C 后的代码是:
...

  TMyList = class(TObject)
  private
    ...
    function GetItems(Index: Integer): Pointer;
    procedure SetItems(Index: Integer; const Value: Pointer);
  public
    ...
    property Items[Index: Integer]: Pointer read GetItems write SetItems;
  end;

implementation

{ TMyList }

...

function TMyList.GetItems(Index: Integer): Pointer;
begin

end;

procedure TMyList.SetItems(Index: Integer; const Value: Pointer);
begin

end;

end.

在 TList 类中, GetItems 方法被命名为 Get; SetItems 方法被命名为 Put. 这里我们就不准备改名了.

分别实现如下:
function TMyList.GetItems(Index: Integer): Pointer;
begin
  if (Index < 0) or (Index >= FCount) then
    raise Exception.CreateFmt('异常:%d', [Index]);
  Result := FList^[Index];
end;

{同前, 在这里我们也没有触动 Notify 方法, 现在的 TMyList 也没有这个方法}
procedure TMyList.SetItems(Index: Integer; const Value: Pointer);
begin
  if (Index < 0) or (Index >= FCount) then
    raise Exception.CreateFmt('异常:%d', [Index]);

  if Value <> FList^[Index] then
    FList^[Index] := Value;
end;

至此, 我们可以使用 List.Itmes[i] 的方式访问列表中的元素了;

再进一步, 让它成为默认属性吧; 尽管只能选择一个属性为默认属性, 但哪一个属性能比它更重要的呢?
//只需把在 public 区声明的:
property Items[Index: Integer]: Pointer read GetItems write SetItems;

//改为:
property Items[Index: Integer]: Pointer read GetItems write SetItems; default;
Items 就是默认属性了, 这样再访问一个元素时, 即可以用: List.Itmes[i]; 也可以使用: List[i]. 默认属性真方便.

看看 TMyList 类目前的全部代码:
unit MyList;

interface

uses SysUtils;

const
  MaxListSize = Maxint div 16;

type
  PPointerList = ^TPointerList;
  TPointerList = array[0..MaxListSize - 1] of Pointer;

  TMyList = class(TObject)
  private
    FList: PPointerList;
    FCount: Integer;
    FCapacity: Integer;
    procedure SetCapacity(const Value: Integer);
    procedure SetCount(const Value: Integer);
    function GetItems(Index: Integer): Pointer;
    procedure SetItems(Index: Integer; const Value: Pointer);
  public
    destructor Destroy; override;
    function Add(Item: Pointer): Integer;
    procedure Clear;
    procedure Delete(Index: Integer);
    property Capacity: Integer read FCapacity write SetCapacity;
    property Count: Integer read FCount write SetCount;
    property List: PPointerList read FList;
    property Items[Index: Integer]: Pointer read GetItems write SetItems; default;
  end;

implementation

{ TMyList }

function TMyList.Add(Item: Pointer): Integer;
begin
  if FCount = FCapacity then SetCapacity(FCapacity + 4);
  FList^[FCount] := Item;
  Result := FCount;
  Inc(FCount);
end;

procedure TMyList.Clear;
begin
  SetCount(0);
  SetCapacity(0);
end;

procedure TMyList.Delete(Index: Integer);
begin
  if (Index < 0) or (Index >= FCount) then
    raise Exception.CreateFmt('非法的 Index:%d', [Index]);
  if Index < FCount then
    System.Move(FList^[Index+1], FList^[Index], (FCount-Index)* SizeOf(Pointer));
  Dec(FCount);
end;

destructor TMyList.Destroy;
begin
  Clear;
  inherited;
end;

procedure TMyList.SetCapacity(const Value: Integer);
begin
  if (Value < FCount) or (Value > MaxListSize) then
    raise Exception.CreateFmt('非法数据:%d', [Value]);
  if FCapacity <> Value then
  begin
    ReallocMem(FList, Value * SizeOf(Pointer));
    FCapacity := Value;
  end;
end;

procedure TMyList.SetCount(const Value: Integer);
var
  i: Integer;
begin
  if (Value < 0) or (Value > MaxListSize) then
    raise Exception.CreateFmt('非法数据:%d', [Value]);
  if Value > FCapacity then SetCapacity(Value);
  if Value > FCount then
    FillChar(FList^[FCount], (Value - FCount) * SizeOf(Pointer), 0)
  else
    for i := FCount - 1 downto Value do
      Delete(I);
  FCount := Value;
end;

function TMyList.GetItems(Index: Integer): Pointer;
begin
  if (Index < 0) or (Index >= FCount) then
    raise Exception.CreateFmt('异常:%d', [Index]);
  Result := FList^[Index];
end;

procedure TMyList.SetItems(Index: Integer; const Value: Pointer);
begin
  if (Index < 0) or (Index >= FCount) then
    raise Exception.CreateFmt('异常:%d', [Index]);

  if Value <> FList^[Index] then
    FList^[Index] := Value;
end;

end.

现在访问元素方便了, 重做上一个测试:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  end;

var
  Form1: TForm1;
implementation

{$R *.dfm}

uses MyList;

type
  TMyRec = record
    name: string[8];
    age : Word;
  end;

procedure TForm1.FormCreate(Sender: TObject);
var
  ListA: TMyList;
  r,r1,r2,r3,r4,r5: TMyRec;
begin
  ListA := TMyList.Create;

  r1.name := '张三';
  r1.age  := 11;
  ListA.Add(@r1);

  r2.name := '李四';
  r2.age  := 22;
  ListA.Add(@r2);

  r3.name := '王五';
  r3.age  := 33;
  ListA.Add(@r3);

  r4.name := '孙六';
  r4.age  := 44;
  ListA.Add(@r4);

  r5.name := '候七';
  r5.age  := 55;
  ListA.Add(@r5);


  {获取第三个元素}
  //r := TMyRec(ListA.List^[2]^);          {这是以前的代码}
  r := TMyRec(ListA[2]^);
  ShowMessageFmt('%s:%d',[r.name, r.age]); {王五:33}

  {删除第三个元素后再访问第三个元素}
  ListA.Delete(2);
  //r := TMyRec(ListA.List^[2]^);          {这是以前的代码}
  r := TMyRec(ListA[2]^);
  ShowMessageFmt('%s:%d',[r.name, r.age]); {孙六:44}

  {现在通过 Items 属性, 不仅可以取值, 还可以赋值}
  ListA[2] := @r1;
  r := TMyRec(ListA[2]^);
  ShowMessageFmt('%s:%d',[r.name, r.age]); {张三:11}

  ListA.Free;
end;

end.

posted on 2008-03-31 14:41  万一  阅读(3842)  评论(14编辑  收藏  举报