TOPページへ戻る  PCページへ戻る  一覧へ戻る TListのカスタマイズの目次へ戻る

2次元配列として使えるカスタムTList

これまで作成したTMyListをさらにTListに入れることで、 2次元配列a[X][Y]のように使えるカスタムTListクラスを作成します。  イメージは次のような感じです。TMyArrayListクラスが行をTMyListクラスが列に 相当します。

TMyArrayListとTListの関係

早速コードを示します。TMyListクラスは、Deleteメソッドが追加されたこと以外、 「Putメソッドの改良」とほぼ同じです。また、今回はUnitとして 作成しています。下のコードをメモ帳にコピーし、MyCustomList.pasとして保存するとUnitファイルとして 使用できます。


unit MyCustomList;

interface

USES Classes;

type
  PMyList = ^TMyList;		// TMyListのポインタ型を定義
  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;		// TMyList.Clearは、その行のデータだけを消去
    procedure Delete(Index:Integer);	// 新たにDeleteメソッドを追加
    property Items[Index:Integer]: Double read Get write Put; default;
  end;

type
  TMyArrayList = class(TList)
  private
    function Get(Index:Integer):TMyList;
    procedure Put(Index:Integer; const Data:TMyList);
  public
    destructor Destroy;override;
    procedure Add;
    procedure Clear;override;		// TMyArrayList.Clearは全てのデータを消去
    procedure Delete(Index:Integer);	// 行の消去に相当。メモリも解放する。
    property Items[Index:Integer]:TMyList read Get write Put; default;
  end;

implementation
 
// TMyArrayListクラスの実装部
destructor TMyArrayList.Destroy;
begin
Clear;				// メモリリークしないよう、ClearしてからDestroyする。
inherited Destroy;
end;

procedure TMyArrayList.Add;
var ml: PMyList;		// TMyListのポインタ型
begin
New(ml);			// TMyList用のメモリを確保
try
ml^ := TMyList.Create;		// TMyListのインスタンスを作成
except
    Dispose(ml);		// 失敗したらメモリを解放
    raise;			// 呼び出し元に伝えるためにエラーを再生成
  end;				// 処理はここで終了し、呼び出し元へ。
try
inherited Add(ml);
except
    ml^.Free;			// mlが作成されているのでFreeする
    Dispose(ml);		// 失敗したらメモリを解放
    raise;			// 呼び出し元に伝えるためにエラーを再生成
  end;
end;

procedure TMyArrayList.Clear;
var i:Integer;
begin
i := 0;
while i < Count do
    begin
    if Assigned(List[i]) then	// ItemsプロパティのポインタであるListプロパティを調べ、
        begin
        Items[i].Free;		// TMyListが割り当てられている場合はそれを解放
        Dispose(List[i]);	// TMyList用に確保されていたメモリを解放
        end;
    Inc(i);
    end;
inherited Clear;		// メモリを解放してからTListのClearを呼び出す
end;

function TMyArrayList.Get(Index:Integer):TMyList;
begin
Result := PMyList(inherited Items[Index])^;	// 後述
end;

procedure TMyArrayList.Put(Index:Integer; const Data:TMyList);
begin
PMyList(List[Index])^ := Data	// Listプロパティを型キャストして代入
end;

procedure TMyArrayList.Delete(Index:Integer);
begin
if Assigned(List[i]) then	// ItemsプロパティのポインタであるListプロパティを調べ、
    begin
    Items[Index].Free;		// ItemsプロパティのTMyListをFree
    Dispose(List[Index]);	// TMyList用のメモリを解放
    end;
inherited Delete(Index);	// メモリ解放してからTListのDeleteを呼び出す
end;

// 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);
var pd : PDouble;
begin
PDouble(List[Index])^ := Data;
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 TMyList.Delete(Index:Integer);
begin
if Assigned(List[Index]) then 
    Dispose(List[Index]);		// TMyList用のメモリを解放
inherited Delete(Index);
end;

end. 

コードの説明

TMyArrayListのAddメソッドは、単にTMyListのメモリを確保し、そのインスタンスを作成する メソッドになっています。これは、TMyArrayListのItemsプロパティ数を増やす際はAddを行い、Addメソッドで 作成したTMyListに値を代入していくことを前提とした設計です。 そのため、TListクラスのAddメソッドのように、TMyListを作成して値を代入したTMyList型の変数を TMyArrayListにAddメソッドで追加できません(TMyArrayList.Add(TMyList)とはできないということです)。

TMyArrayListのGetメソッドでは、TMyList型を返します。Getメソッドは、TMyArrayList[x][y]という コードで呼び出されるメソッドであるため、TMyList型ではなくDouble型を返すのでは?と思うかも知れません。 しかし、TMyArrayListのGetメソッドが呼び出されるのは、TMyArrayList[x]というコードであるため、そのGetメソッド でDouble型を返すとTMyArrayList[x][y]は、Double([y])という意味不明のコードになります。 即ち、Double型を返すのはTMyListのGetメソッドであるため、TMyArrayListのGetメソッドではTMyList型を返せば 良いのです。これは、次の順序でGetメソッドが呼び出されることからも分かると思います。

TMyArrayList[x][y] → TMyArrayList.Get(x)[y] → TMyList[y] → TMyList.Get(y) → Double型が返る

使い方

今回は、メモ帳に書かれたn行m列の数値を読み取り、各行で整列をしてから 最初の行の最小値と最後の行の最大値を入れ替えるプログラムを作りました。


動作例


unit Unit1;

interface

uses
  SysUtils, Classes, Forms, Controls, StdCtrls, Math, MyCustomList;

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

function CompareDouble(item1,Item2:Pointer):Integer;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// Sortメソッド用関数
function CompareDouble(item1,Item2:Pointer):Integer;
begin
Result := Sign(PDouble(item1)^ - PDouble(item2)^);
end;

procedure TForm1.Button1Click(Sender: TObject);
var st: TStringList;
    i,j : Integer;
begin
st := TStringList.Create;
try
mal.Clear;
i := 0;
while i < Memo1.Lines.Count do
    begin
    st.CommaText := Memo1.Lines[i];	// メモの各行をコンマで区切って読み取り
    mal.Add;				// TMyListのメモリを確保
    j := 0;
    while j < st.Count do
        begin
        try
        mal[i].Add(StrToFloat(st[j]));	// TMyListに値を代入
        except
            ;
          end;
        Inc(j);
        end;  
    Inc(i);
    end;
finally
    FreeAndNil(st);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var i,j,n: Integer;
    S: String;
    tf: Double;
begin
if mal.Count = 0 then exit;		// ListにItemが無い場合は終了
i := 0;
while i < mal.Count do
    begin
    mal[i].Sort(@CompareDouble);	// 各行を昇順に整列
    Inc(i);
    end;
tf := mal[0][0];			// 値の入れ替え
n := mal[mal.Count-1].Count;
mal[0][0] := mal[mal.Count-1][n-1];
mal[mal.Count-1][n-1] := tf;
i := 0;
S := '';
while i < mal.Count do
    begin
    j := 0;
    while j < mal[i].Count do
        begin
        S := S + FloatToStr(mal[i][j])+ ' ';	// 表示文字列の整形
        Inc(j);
        end;
    S := S + #13#10;			// 行が変わるときは改行文字を入れる
    Inc(i);
    end;
Label1.Caption := S;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
mal := TMyArrayList.Create;		// アプリ起動時にTMyArrayList型変数のインスタンスを作成
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FreeAndNil(mal);			// アプリ終了時はTMyArrayList型変数を廃棄
end;

end. 

いかがでしょうか?ちなみに、TMyArrayListクラスのExchangeメソッドは正常に動作 するため、行の入れ替えを行うこともできます。また、TMyArrayListクラスに行の入れ替えを行う メソッドを新規に定義(例えばColumnExchangeメソッド)すると、列を入れ替えることも可能です。 これらのメソッドが使えると、行列の操作が楽になると思います。さらにそれらのメソッドを使って拡張し、 ガウスの消去法を使って三角行列に変形するメソッドを作ったりも出来ると思います。

次は、Itemsプロパティに複数のデータを保持できるTCustomListクラスを作成します。 これは住所録などを作るときに使えると思います。

複数のデータをItemsプロパティに保持するクラス

TOPページへ戻る  PCページへ戻る  一覧へ戻る TListのカスタマイズの目次へ戻る