次のようなカスタムTListクラスを作ることでItem プロパティを型キャスト無しで読み取ることができます。ここでは、ItemsプロパティにDouble型の 変数持つことを前提としています。

type
  TMyList = class(TList)
  private
    function Get(Index:Integer):Double;
    procedure Put(Index:Integer; const Data:Double);
  public
    property Items[Index:Integer]: Double read Get write Put; default;
  end;

function TMyList.Get(Index:Integer):Double;
begin
Result := PDouble(inherited Get(Index))^;	// PDoubleでポインタをキャストし、^演算子で中身を参照
end;

procedure TMyList.Put(Index:Integer; const Data:Double);
begin
inherited Put(Index,@Data);			// @演算子でDataのアドレスを渡す
end; 

コードの説明

Itemsプロパティは、Getメソッドで呼び出され、Putメソッドで値を代入します。 今回のTMyListでは、Itemsプロパティを読み取る際にポインタ型ではなくDouble型を返して欲しいため、 property Items[Index:Integer]: Double 〜とDouble型となります。 また、Itemsプロパティを読み出す際に呼び出されるGetメソッドは、Itemsプロパティの型と同じで なくてはなりません。そのため、Get関数の戻り値はDoubleになります。
　同様に、Put手続きの引数のDataは、Itemsプロパティの戻り値と同一の型である必要があります。 しかし、inherited Putで呼び出されるTListクラスのPut手続きでは、Indexとポインタを渡す必要が あるため、Double型のDataを@演算子を付けてinherited Put手続きの引数にしています。
　Itemsプロパティの最後にdefault指令が付いています。これを付けることで、 MyList.Items[i]と書くところをMyList[i]と省略することが出来るようになります。 default指令が付いたプロパティが、そのクラスで呼び出されるデフォルトのプロパティとなるためです。

このコードでは、予約語inheritedを多用します。inheritedが付いたメソッドは、 継承されたクラスのメソッドを呼び出します。例えば、TMyList.Getメソッド中の”inherited Get(index)”は、 TMyList.Getメソッドを呼び出すのではなく、TListのGetメソッドを呼び出します。

使い方

ここでは、フォームにボタンが２つ、Editボックスが１つ、Labelが１つ貼り付けられた アプリケーションを作りました（下の図）。 Editボックスにカンマ区切りで数値を入れ、ボタン1「代入」をクリック するとTMyList型のグローバス変数mlに値を代入し、ボタン2「合計」を押すとmlの数値の合計を表示します。

動作例

unit Unit1;

interface

uses
  SysUtils, Classes, Forms, Controls, StdCtrls;

type						// TMyListの定義
  TMyList = class(TList)			// TListクラスの継承
  private
    function Get(Index:Integer):Double;		// Itemsプロパティの読み出し用関数
    procedure Put(Index:Integer; const Data:Double);// Itemsプロパティへ代入する関数
  public
    property Items[Index:Integer]: Double read Get write Put; default;
  end;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 宣言 }
    ml : TMyList;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TMyList.Get(Index:Integer):Double;
begin
Result := PDouble(inherited Get(Index))^;	// PDoubleでポインタをキャストし、^演算子で中身を参照
end;

procedure TMyList.Put(Index:Integer; const Data:Double);
begin
inherited Put(Index,@Data);			// @演算子でDataのアドレスを渡す
end;

procedure TForm1.Button1Click(Sender: TObject);
var st: TStringList;				// 文字列格納用のList
    i : Integer;
    pd: ^Double;				// TMyListにAddするためのポインタ
begin
st := TStringList.Create;
try
st.CommaText := Edit1.Text;			// Edit1のテキストをカンマで分解してstのItemsプロパティに格納する
i := 0;
while i < st.Count do
    begin
    New(pd);					// Double型のメモリ領域を確保
    try
    pd^ := StrToFloat(st[i]);			// ポインタpdの中身pd^にDouble型の数値を格納
    ml.Add(pd);
    except
        Dispose(pd);				// StrToFloatが失敗したらメモリを解放する
      end;
    Inc(i);
    end; 
finally
    FreeAndNil(st);				// 使い終わったTStringListを解放
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var i: Integer;
    d: Double;
begin
i := 0;
d := 0;
while i < ml.Count do
    begin
    d := d + ml[i];
    Inc(i);
    end;
Label1.Caption := FloatToStr(d);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ml := TMyList.Create;				// アプリケーション起動時にTMyList型変数mlを作成
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var i: Integer;
begin
i := 0;
while i < ml.Count do
    begin
    if Assigned(ml.List[i]) then Dispose(ml.List[i]);	// Itemsプロパティのポインタである
    Inc(i);						// Listプロパティを調べて、値があれば破棄
    end;
FreeAndNil(ml);					// アプリケーション終了時にはmlを解放
end;

end. 

改善点・問題点

上のコードには下に示す改善点や問題点があります。

• 上のコードでは、AddメソッドでItemsプロパティに値を追加する際、 毎回PDouble型（Doubleのポインタ）変数を用意する必要がある
• TMyListを破棄する際、毎回TForm1.Closeのコードを記述しなくてはならない
• 再びボタン「代入」を押した際、前回のItemsを破棄する必要がある。しかし、 Clearメソッドを呼び出すと、メモリリークを起こす
• Itemsプロパティに格納された値をある関数/手続き内で変更しても、 別の関数/手続きでそれを 呼び出そうとすると変な値になる。

上から順番にコードが面倒になります。次のページでは、 ます上の3つを改善する方法を示します。

次のページへ