Itemsプロパティの中身の値を変更するには、Putメソッドをちょっと 改良するだけで済みます。下のコードで、TMyList.Putをご覧ください。

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;
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
PDouble(List[Index])^ := Data;		// Listプロパティをキャストして、データを代入
end;

procedure TMyList.Add(Data:Double);
var pd : PDouble;
begin
New(pd);
try
pd^ := Data;
inherited Add(pd);
except
    Dispose(pd);
    raise;				// エラーの再生成
  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; 

コードの説明

「Add、Clearメソッド、及びデストラクタの実装」の Putメソッドは、Getメソッドにならってinherited Putを使っていました。 これでは、変数のポインタとItemsプロパティに格納された値の ポインタを入れ替えるだけです。そのため、前のページのコードのPutメソッドを使って値を 入れ替えようとすると、それまで保持していたメモリを解放せずにポインタを入れ替えるのでメモリリークを起こします。 さらに、Putメソッドを呼び出した関数/手続きを抜けると、Putメソッドの引数にした変数のメモリは解放されるため、 Button2を押したときにAccessViolationが生じます。
　この不具合を防ぐために、「PutメソッドとはItemsプロパティへの代入」と考えて上のように修正しました。 ここで、Itemsプロパティへの代入ならば、Items[Index] := Dataとしたいところですが、 PutメソッドはItemsプロパティのメソッドになっているため、Items[Index] := Dataとすると無限ループに陥ります。 これを防ぐために、Itemsプロパティのポインタを保持しているListプロパティを型キャストして代入しています。

前回のAddメソッドでは、エラーが生じた際はメモリを解放するだけでした。 これでは、try〜exceptの保護ブロック内で生じたエラーは”except内で処理済み”と判断されるため、 Addメソッドの呼び出し元には何のエラーなのか伝わりません。 それを伝えるために、エラーを再生成する予約後raiseをexcept内に付け加えました。

使い方

「型キャスト無しでItemプロパティを読み出す」で 作ったアプリケーションちょっと改良したアプリケーションを作りました。これは、 エディットボックスにカンマ区切りで入力した数値を昇順で整列し、最大値と最小値を入れ替えてから 表示するアプリケーションです。

動作例

unit Unit1;

interface

uses
  SysUtils, Classes, Forms, Controls, StdCtrls, Math; // Sign関数のためにMathユニット追加

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;

function CompareDouble(item1,Item2:Pointer):Integer;	// TList.Sortを使うための関数
							// （「TList.Sortメソッドを使った整列」参照）
var
  Form1: TForm1;

implementation

{$R *.dfm}

// TList.Sortメソッド用関数
function CompareDouble(item1,Item2:Pointer):Integer;
begin
Result := Sign(PDouble(item1)^ - PDouble(item2)^);	// Signで符号を返す。
end;							// if　評価式 < 0 then Result := -1 else 〜では、
							// 正常に並べ替えが出来ない
// 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
PDouble(List[Index])^ := Data;		// Listプロパティをキャストして、データを代入
end;

procedure TMyList.Add(Data:Double);
var pd : PDouble;
begin
New(pd);
try
pd^ := Data;
inherited Add(pd);
except
    Dispose(pd);
    raise;
  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;

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]));
    except
        ;
      end;
    Inc(i);
    end;
finally
    FreeAndNil(st);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var i: Integer;
    S: String;
    tf: Double;
begin
if ml.Count = 0 then exit;		// ListにItemが無い場合は終了
ml.Sort(@CompareDouble);		// 並べ替え
tf := ml[0];				// 最大値・最小値の入れ替え
ml[0] := ml[ml.Count-1];		// 値を代入
ml[ml.Count-1] := tf;
i := 0;
S := '';
while i < ml.Count do
    begin
    S := S + FloatToStr(ml[i])+ ' ';
    Inc(i);
    end;
Label1.Caption := S;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ml := TMyList.Create;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FreeAndNil(ml);
end;

end. 

これで値を入れ替えることが簡単にできるようになりました。 しかし、TListに数値を入れるだけならば動的配列を使うことと変わりません（そして動的配列を 使った方が動作が早いです）。そこで、次は、TListを入れ子にして、2次元配列として使える TMyArraListクラス、或いは複数のデータをItemsプロパティに保持するクラスを作ります。

次のページへ