Itemsプロパティにアイテムを追加する際、毎回PDouble型の変数を 使って代入しなくて済むよう、Addメソッドを実装します。また、すでに入っている値を クリアすることを考慮して、Clearメソッドを実装します。さらに、TMyList型の変数を 破棄する際、メモリリークになるItemsプロパティの破棄を忘れないよう、デストラクタ でItemsプロパティのメモリを解放します。

この改良を加えたコードは下のようになります。

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

destructor TMyList.Destroy;
begin
Clear;					// Clearメソッドを呼び出し、Itemsプロパティのメモリを解放
inherited Destroy;			// TListのDestroyを実行
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;

procedure TMyList.Add(Data:Double);
var pd : PDouble;			// メモリ確保用のDoubleのポインタ型の変数
begin
New(pd);				// メモリ確保
try
pd^ := Data;				// ^演算子でポインタ変数pdにDouble型のDataを代入
inherited Add(pd);			// Itemsプロパティに値を追加
except
    Dispose(pd);			// 失敗した場合、確保したメモリを解放する
  end;
end;

procedure TMyList.Clear;
var i : Integer;
begin
i := 0;
while i < Count do
    begin
    if Assigned(List[i]) then Dispose(List[i]);	// ItemsプロパティのポインタであるListプロパティを調べ、
    Inc(i);					// メモリが確保されていたら破棄しnilを代入
    end;
inherited Clear;				// TListのClearを実行しItems用のメモリを解放
end; 

コードの説明

Add、Clear、デストラクタが追加されいますが、基本はItemsプロパティのメモリ操作 をする以外は、TListクラスの各メソッドを呼び出しているだけです。
　Addメソッドでは、New手続きでDouble型のメモリを確保し、引数のDataをそのメモリに確保して Itemsプロパティに追加しています。クリアメソッドでは、全てのListプロパティを調べてメモリが 確保されていたら廃棄しています。ここではItemsプロパティをカスタマイズしてDouble型になっている ため、Itemsプロパティのポインタが格納されているListプロパティをAssigned関数で調べています。
　デストラクタであるDestory手続きでは、TMyListのクリアを呼び出してItemsプロパティのメモリを 解放し、TListのデストラクタを実行しています。

使い方

「型キャスト無しでItemプロパティを読み出す」で 作ったアプリケーションを上のTMyListを使って書き直すと次のようになります。

unit Unit1;

interface

uses
  SysUtils, Classes, Forms, Controls, StdCtrls;

type
  TMyList = class(TList)
  private
    function Get(Index:Integer):Double;
    procedure Put(Index:Integer; const Data:Double);
  public
    destructor Destroy;override;
    procedure Add(Data:Double);
    procedure Clear;override;
    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}

// TMyListクラス
destructor TMyList.Destroy;
begin
Clear;
inherited Destroy;
end;

function TMyList.Get(Index:Integer):Double;
begin
Result := PDouble(inherited Get(Index))^;
end;

procedure TMyList.Put(Index:Integer; const Data:Double);
begin
inherited Put(Index,@Data);
end;

procedure TMyList.Add(Data:Double);
var pd : PDouble;
begin
New(pd);
try
pd^ := Data;
inherited Add(pd);
except
    Dispose(pd);
  end;
end;

procedure TMyList.Clear;
var i : Integer;
begin
i := 0;
while i < Count do
    begin
    if Assigned(List[i]) then Dispose(List[i]);
    Inc(i);
    end;
inherited Clear;
end;

// Form1クラス
procedure TForm1.Button1Click(Sender: TObject);
var st: TStringList;
    i : Integer;
begin
st := TStringList.Create;
try
ml.Clear;					// 新しい配列を作るため、古いものをクリア
st.CommaText := Edit1.Text;
i := 0;
while i < st.Count do
    begin
    try
    ml.Add(StrToFloat(st[i]));			// Double型の変数をそのまま追加
    except
        ;
      end;
    Inc(i);
    end;
finally
    FreeAndNil(st);
  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;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FreeAndNil(ml);					// FreeAndNilでTMyList型の変数を破棄。
end;						// デストラクタが呼び出されてメモリが解放される

end. 

改善点・問題点

上のコードで、必要な機能はほとんど実装されたと思います。

次のページでは、Itemsプロパティの値を変更できるようにPut手続きを カスタマイズします。

次のページへ