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

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

今度はItemsプロパティに複数のデータを保持するカスタムTListクラスを作成します。 これは、TListクラスのItemsプロパティにTObjectを継承したクラスのポインタを渡すだけです。 前述の「2次元配列として使えるカスタムTList」で、TMyArrayListの ItemsプロパティにTMyListのポインタを保持させたのと同様になります。
 複数のデータをItemsプロパティに保持するクラスの作成にあたり、2つ注意する点があります。

  1. Itemsプロパティに保持するクラスはTObjectを継承したクラスにする
  2. record型をItemsプロパティに保持することでも、複数のデータを保持するカスタムTListクラスを 作成できます。しかし、この手法では、TList[x].X := Yという形で値を変更することができません。 これは、record型の変数の場合、その要素となる変数がメモリのどの位置に存在するかを関知しない ためです。

  3. 大量のデータを保持する場合、Capacityプロパティに注意
  4. TListクラスではCapacityプロパティはメモリを保持しているItemsプロパティの数を 指します。しかし、ItemsプロパティにTObjectなど複数のデータを持つクラスを保持する場合、 Capacityプロパティはメモリを保持しているItemsプロパティより大きめの値を取ります。 (特に、TObjectが使用するメモリが64Byteを越えるとそうなります)
     そのような場合、Capacityが増えるメソッド(例えばAddメソッド)で、Capacity := Countと 指定することでメモリの無駄を省けます。

この例を下のコードに示します。今回もUnitとして作成していますので、下のコードをメモ帳に コピーし、MyCustomList3.pasとして保存するとUnitファイルとして使用できます。
 下のコードでは、TObjectを継承するクラスとして、Double型の変数を3つ持つクラスTTripleDoubleクラスを 定義しています。また、TMyListクラスはItemsプロパティにTTripleDoubleクラスを保持するカスタムTListクラス です。


unit MyCustomList3;

interface

USES Classes;

type
  PTripleDouble = ^TTripleDouble;	// TTripleDouble型のポインタ
  TTripleDouble = class(TObject)	// TTripleDoubleクラスはTObjectから継承
    public
    X,Y,Z:Double;			// 3つのDouble型をPublicメンバに持つ
  end;

type
  TMyList = class(TList)		// TMyListクラスはTListクラスから継承
  private
    function Get(Index:Integer):TTripleDouble;
    procedure Put(Index:Integer; const Data:TTripleDouble);
  public
    destructor Destroy;override;
    procedure Add(Data:TTripleDouble);
    procedure Clear;override;
    procedure Delete(Index:Integer);
    property Items[Index:Integer]: TTripleDouble read Get write Put; default;
  end;

implementation

destructor TMyList.Destroy;
begin
Clear;				// メモリリークしないようClearしてから
inherited Destroy;		// Destroyする
end;

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

procedure TMyList.Put(Index:Integer; const Data:TTripleDouble);
begin
{PTripleDouble(List[index])^.X := Data.X;	// Putメソッドは値の代入と等価
PTripleDouble(List[index])^.Y := Data.Y;
PTripleDouble(List[index])^.Z := Data.Z;}
PTripleDouble(List[index])^ := Data;
end;

procedure TMyList.Add(Data:TTripleDouble);
var pd : PTripleDouble;
    cn,cp: Integer;
begin
New(pd);
cn := Count;			// 元のCountプロパティを保持
cp := Capacity;			// 元のCapcityプロパティを保持
try
pd^ := TTripleDouble.Create;	// TTripleDoubleのインスタンスを作成
except
    Dispose(pd);		// インスタンス作成に失敗したらメモリ解放
    raise;			// エラーを再生成し、処理を抜ける
  end;
try
pd^.X := Data.X;		// 値を代入。pd^ := Dataでは、値が
pd^.Y := Data.Y;		// 代入されない(Dataのポインタが
pd^.Z := Data.Z;		// 渡されるだけで値は代入されない)
inherited Add(pd);
if cn = cp then			// CapacityとCountが元々等しかったら
    Capacity := Count;		// CapacityをCountと等しくする
except
    pd^.Free;			// pdを破棄
    Dispose(pd);		// Addに失敗したらメモリ解放
    raise;			// エラーを再生成し、処理を抜ける
  end;
end;

procedure TMyList.Clear;
var i : Integer;
begin
i := 0;
while i < Count do
    begin
    if Assigned(List[i]) then	// Itemsプロパティが存在する場合、
        begin
        Items[i].Free;		// そのオブジェクトをFreeして
        Dispose(List[i]);	// メモリを破棄する
        end;
    Inc(i);
    end;
inherited Clear;
end;

procedure TMyList.Delete(Index:Integer);
begin
if Assigned(List[Index]) then	// Itemsプロパティが存在する場合、
    begin
    Items[Index].Free;		// そのオブジェクトをFreeして
    Dispose(List[Index]);	// メモリを破棄する
    end;
inherited Delete(Index);
end;

end. 

コードの説明

前述の「2次元配列として使えるカスタムTList」 で、TMyArrayListをTMyListに、TMyListをTTripleDoubleに置き換えたものとほぼ同等です。 大きく異なるのは、PutメソッドとAddメソッドです。

前々述の「Putメソッドの改良」では、 Putメソッドは代入と等価と考えてPutメソッドの引数をListプロパティを介してItemsプロパティに代入しました。 今回、同様のコードを書くとすれば、次のようになります。

procedure TMyList.Put(Index:Integer; const Data:TTripleDouble);
begin
PTripleDouble(inherited List[index])^ := Data;
end;

一見、このコードでも正しく動きそうな気がします。しかし、上記のコードが意味するところは、 ”DataのポインタをList[Index]へ渡す”です。ちゃんとPTripleDouble型にキャストしているにも関わらず、 ポインタを入れ替えるだけになっている原因は、”Delphiでは、オブジェクトの代入はポインタの受け渡し” だからです。TTripleDoulbeクラスはTObjectを継承しているため、TTripleDoulbe型はオブジェクトなのです。 それ故、上述のコードでは単なるポインタの入れ替えになってしまいます。

その様な訳で、PutメソッドではListプロパティをキャストし、TTripleDoulbleの各要素ごとに 値を代入しています。しかし、このコードでは、Items[x].Z := Items[y].Zと記述した際にZだけでなく X、Yも同時に代入されてしまいそうな感じがしますが、それはありません。 必要な要素だけが呼び出されて代入されるため、Items[x].Z := Items[y].Zと書くことでZの値だけが変化します。

【2006/03/05訂正】上のコードで正常に代入されます。上の文は私の勘違いです。

一方、Addメソッドの変更点は、Itemsプロパティに保持するデータ量が64Byteを越える時に Capacityプロパティが無駄に大きく取られるのを防ぐコードを追加したところです(Addメソッドの太字部)。 TTripleDoubleは4Byte×3=12Byte程度のデータ量しか無いため、このコードはあまり意味がありません。 しかし、16個より多いメンバを持つオブジェクトやAnsiString、WideStringをメンバに持つオブジェクトでは 必要になると思います。(Capacityプロパティがこのような挙動を示す理由は、 {Delphi Install Dir}\Source\Rtl\Common\Classes.pasのTList.Growを見ると分かります)

使い方

今回は、メモに書かれた各行の2つの数値を読み取り、その差を求め、 差によって整列し直した結果を別のメモに表示するプログラムを作りました。但し、代入の検証を するために、結果を表示する直前に、最後の行の差を最初の行の差と置き換えています。


動作例


unit Unit1;

interface

uses
  Windows, SysUtils, Classes, Controls, Forms,
  StdCtrls, Math, MyCustomList3;

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

function CompareZ(item1,item2:Pointer):Integer;	// 差で整列するための関数

var
  Form1: TForm1;

implementation

{$R *.dfm}

function CompareZ(item1,item2:Pointer):Integer;
begin
Result := Sign(PTripleDouble(item1)^.Z - PTripleDouble(item2)^.Z);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ml := TMyList.Create;		// TMyList型のグローバル変数のインスタンスを作成
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FreeAndNil(ml);			// アプリ終了時に変数mlを解放
end;

procedure TForm1.Button1Click(Sender: TObject);
var i  :Integer;
    st : TStringList;		// コンマでの文字分割に使用
    tl : TTripleDouble;
begin
st := TStringList.Create;
tl := TTripleDouble.Create;	// TTripleDoubleのインスタンスを作成
ml.Clear;			// 前の結果をクリア
i := 0;
try
while i < Memo1.Lines.Count do
    begin
    st.Clear;
    st.CommaText := Memo1.Lines[i];	// コンマで文字を分ける
    tl.X := StrToFloat(st[0]);		// 最初の値をXに
    tl.Y := StrToFloat(st[1]);		// 次の値をYに
    tl.Z := 0;				// Zには0を代入
    ml.Add(tl);
    Inc(i);
    end;
finally
    FreeAndNil(st);		// Createしたものを解放
    FreeAndNil(tl);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var i : Integer;
    tZ: Double;
begin
Memo2.Text := '';
i := 0;
while i < ml.Count do
    begin
    ml[i].Z := ml[i].X - ml[i].Y;	// ZにX-Yを代入
    Inc(i);
    end;
ml.Sort(CompareZ);			// Zで昇順に整列
tZ := ml[ml.Count-1].Z;			// 最初のZと最後のZを入れ替え
ml[ml.Count-1].Z := ml[0].Z;
ml[0].Z := tZ;
i := 0;
while i < ml.Count do		// メモへの表示
    begin
    Memo2.Lines.Add(FloatToStr(ml[i].X)+', '
                   +FloatToStr(ml[i].Y)+', '
                   +FloatToStr(ml[i].Z));
    Inc(i);
    end;
end;

end.

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