今度はItemsプロパティに複数のデータを保持するカスタムTListクラスを作成します。
これは、TListクラスのItemsプロパティにTObjectを継承したクラスのポインタを渡すだけです。
前述の「2次元配列として使えるカスタムTList」で、TMyArrayListの
ItemsプロパティにTMyListのポインタを保持させたのと同様になります。
複数のデータをItemsプロパティに保持するクラスの作成にあたり、２つ注意する点があります。
- Itemsプロパティに保持するクラスはTObjectを継承したクラスにする
- 大量のデータを保持する場合、Capacityプロパティに注意
そのような場合、Capacityが増えるメソッド（例えばAddメソッド）で、Capacity := Countと 指定することでメモリの無駄を省けます。
この例を下のコードに示します。今回もUnitとして作成していますので、下のコードをメモ帳に
コピーし、MyCustomList3.pasとして保存するとUnitファイルとして使用できます。
下のコードでは、TObjectを継承するクラスとして、Double型の変数を３つ持つクラス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を見ると分かります）
使い方
今回は、メモに書かれた各行の２つの数値を読み取り、その差を求め、 差によって整列し直した結果を別のメモに表示するプログラムを作りました。但し、代入の検証を するために、結果を表示する直前に、最後の行の差を最初の行の差と置き換えています。
動作例
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.