前の章へ| 総目次へ
| 次の章へ 
｜TList、TStringList、TObjectList などのリストクラスは非常に便利なクラスである。このような汎用リストクラスと動的配列を比較してみると、リストクラスでは、
１）要素の数の増加に伴って自動的にサイズが拡張される
２）要素の追加、挿入、削除、検索、ソートなどがメソッドとして利用できる
３）コピーやファイルへの保存、読み込みなどがメソッドとして利用できる
など、小さなデータベースをつくるには十分な機能を持つことができる。わたしは本格的なデータベースを知らないので、自分の住所録や文献データの整理などを考えるとき、すぐにレコード型のリストを作成したら便利だろうな、と思ってしまいます。VCL プログラミングにおいても、integer 型や自分で定義したレコード型のリストが簡単に実現できるクラスがあれば非常に便利だろう。ここでは簡単な integer 型のリストクラスを作ることからはじめて、それを拡張して、一般的なレコード型を項目として保持する汎用リストクラスのテンプレートを作成する。
なお、このトピックは [Delphi-ML:58021] 変数のリストについて、から始まるスレッドで山本さん、高岡さん、中村さんらと議論した内容をもとにしている。三氏らに感謝申し上げたい。
| 第４章 汎用リストクラス |
| ４−１ Integer のリスト |
| ４−２ Objects の追加 |
| ４−３ ソートとファイルアクセス |
| ４−４ 汎用リストクラス |
| ４−５ オブジェクトでデータを保持する |
| ４−６ ファイルアクセスとコピー |
| ４−７ まとめ |
前の章へ| 総目次へ
| 次の章へ ｜Integer 型の動的リストを保持するクラスを作成しよう。Win32 では、ポインタと Integer 型は同じ３２ビットの幅なので、ポインタのリストである TList を使うと入出力部分をキャストするだけで、簡単に作成できる。しかし、これは保持する項目に対して一般的な手法ではない。ポインタの幅と同じ幅の変数しか適用できないからである。一方、どんな変数でもレコード型の変数でも、そのポインタを渡すとリストとして保持できる。したがって、ポインタのリストを保持する TList クラスはもっとも汎用的なリストクラスである、と言えるだろう。ポインタは、メモリ上に確保された実体への参照（アドレス）にすぎないので、各項目の実体そのものは、メモリ上に別途割り当てなくてはならない。ここでは、TList クラスの外装を真似て、Integer 型の変数を保持するリストクラスをつくってみる。実装したユニットファイルの全リストを以下に示す。
List 1
unit DataListUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, StdCtrls;
type
PDataItem = ^TDataItem;
TDataItem = Integer;
TDataList = class(TObject)
private
FList:TList;
function GetCount:integer;
protected
function Get(Index:integer):TDataItem;
procedure Put(Index:integer;Item:TDataItem);
public
constructor Create;
destructor Destroy; override;
function Add(Item:TDataItem):integer;
procedure Clear;
procedure Delete(Index:integer);
procedure Exchange(Index1,Index2:integer);
function IndexOf(Item:TDataItem):integer;
procedure Insert(index:integer;Item:TDataItem);
function Remove(Item:TDataItem):integer;
property Items[Index:Integer]:TDataItem read Get write Put; default;
property Count:integer read GetCount;
end;
implementation
{ TDataList }
constructor TDataList.Create;
begin
FList := TList.Create;
end;
destructor TDataList.Destroy;
begin
Clear;
FList.Free;
inherited;
end;
function TDataList.Add(Item:TDataItem):integer;
var
pDI:PDataItem;
begin
New(pDI);
pDI^ := Item;
result := FList.Add(pDI);
end;
function TDataList.Get(Index:integer):TDataItem;
begin
result := PDataItem(FList.Items[Index])^;
end;
procedure TDataList.Put(Index:integer;Item:TDataItem);
begin
PDataItem(FList.Items[Index])^ := Item;
end;
function TDataList.GetCount:integer;
begin
result := FList.Count;
end;
procedure TDataList.Clear;
var
i:integer;
begin
for i := 0 to FList.Count-1 do
Dispose(PDataItem(FList.Items[i]));
FList.Clear;
end;
procedure TDataList.Delete(Index:integer);
begin
Dispose(PDataItem(FList.Items[index]));
FList.Delete(index);
end;
procedure TDataList.Exchange(Index1,Index2:integer);
begin
FList.Exchange(index1,index2);
end;
function TDataList.IndexOf(Item:TDataItem):integer;
var
i:integer;
begin
result := -1;
for i := 0 to FList.Count-1 do
if PDataItem(FList[i])^ = Item then begin
result := i;
break;
end;
end;
procedure TDataList.Insert(index:integer;Item:TDataItem);
var
pDI:PDataItem;
begin
New(pDI);
pDI^ := Item;
FList.Insert(index,pDI);
end;
function TDataList.Remove(Item:TDataItem):integer;
begin
result := IndexOf(Item);
if result <> -1 then Delete(result);
end;
end.
このクラスを使ってテストするプログラムを以下に示す。
List 2
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, DataListUnit;
type
TForm1 = class(TForm)
ListBox1: TListBox;
ListBox2: TListBox;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
DL:TDataList;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
DL := TdataList.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DL.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i,value:integer;
begin
DL.Clear;
Randomize;
for i := 0 to 10 do begin
value := Random(100000);
DL.Add(value);
ListBox1.Items.Add(Format('%2d : %5d',[i,value]));
end;
//DL.Delete(7);
//DL.Exchange(0,10);
DL.Insert(7,77777);
//DL.Remove(77777);
for i := 0 to DL.Count-1 do
ListBox2.Items.Add(Format('%2d : %5d',[i,DL[i]]));
end;
実行時の様子を右図に示す。ここでは、ランダムな数値を１１個保持させ、７番目に 77777 を挿入して、その結果を ListBox2 に表示している。いろいろなメソッドを試してみてほしい。
クラスの実装コードを見てみよう。まず、項目そのものの宣言を見てみよう。
type PDataItem = ^TDataItem; TDataItem = Integer;
このようにして、直接 Integer 型として保持するより、いったん TDataItem などとして一般的な型宣言をしておくと、あとから拡張するときに劇的に便利になる。つぎにコンストラクタを見てみよう。
constructor TDataList.Create; begin FList := TList.Create; end;
このクラスは、TObject から直接派生しており、コンストラクタでは private フィールドに宣言した TList のインスタンス FList を作成しているだけである。
新しい項目をリストの末尾に追加する Add メソッドを見てみる。
function TDataList.Add(Item:TDataItem):integer; var pDI:PDataItem; begin New(pDI); pDI^ := Item; result := FList.Add(pDI); end;
ここでは、渡された項目に対応するメモリを New() で確保し、その実体（逆参照）に値を代入してから、ポインタを FList に追加している。Add() メソッドは、追加された項目のインデックスを返す。このようにして、メモリ上の実体とそれを指すポインタをつくり、ポインタを TList のインスタンスで保持しているのである。インデックスを指定して項目を削除する Delete を見てみよう。
procedure TDataList.Delete(Index:integer); begin Dispose(PDataItem(FList.Items[index])); FList.Delete(index); end;
このように、FList の項目を PDataItem にキャストし、Dispose() で解放してから、FList から該当ポインタを削除する。つぎに、項目の値を指定して、その該当インデックスをもとめる IndexOf() メソッドを見てみる。
function TDataList.IndexOf(Item:TDataItem):integer;
var
i:integer;
begin
result := -1;
for i := 0 to FList.Count-1 do
if PDataItem(FList[i])^ = Item then begin
result := i;
break;
end;
end;
これは、FList の項目を PDataItem にキャストしてから逆参照をつかって、値を比較しながら巡回しているだけである。全項目を削除する Clear メソッドを見てみる。
procedure TDataList.Clear;
var
i:integer;
begin
for i := 0 to FList.Count-1 do
Dispose(PDataItem(FList.Items[i]));
FList.Clear;
end;
ここでは、全項目を巡回してその実体をメモリから解放してから、TList の Clear つかって、ポインタのリストをクリアしている。他のメソッドについては、ここまで理解できると簡単に意味が分かるだろう。ここでは、Sort() メソッドを装備していない。後の節で追加する。
文字列の汎用リストは、VCL では TStringList である。ここでは、このクラスをお手本にしたい。そこで、各項目に関連づけられる Objects[] フィールドを追加しよう。このフィールドは、TStringList と同様に TObject 型である。これは実際にはポインタなので、キャストするとどんなデータも各項目に関連付けることができる。改良版の TDataList クラスの全コードを以下に示す。
List 3
unit DataListUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, StdCtrls;
type
PDataItem = ^TDataItem;
TDataItem = Integer;
PDataObjectItem = ^TDataObjectItem;
TDataObjectItem = record
DI:TDataItem;
Obj:TObject;
end;
TDataList = class(TObject)
private
FList:TList;
function GetCount:integer;
function GetObjects(Index: Integer): TObject;
procedure SetObjects(Index: Integer; const Value: TObject);
protected
function Get(Index:integer):TDataItem;
procedure Put(Index:integer;Item:TDataItem);
public
constructor Create;
destructor Destroy; override;
function Add(Item:TDataItem):integer;
procedure Clear;
procedure Delete(Index:integer);
procedure Exchange(Index1,Index2:integer);
function IndexOf(Item:TDataItem):integer;
procedure Insert(index:integer;Item:TDataItem);
function Remove(Item:TDataItem):integer;
function IsEqual(Item1,Item2:TDataItem):Boolean;
property Items[Index:Integer]:TDataItem read Get write Put; default;
property Objects[Index:Integer]:TObject read GetObjects write SetObjects;
property Count:integer read GetCount;
end;
implementation
{ TDataList }
constructor TDataList.Create;
begin
FList := TList.Create;
end;
destructor TDataList.Destroy;
begin
Clear;
FList.Free;
inherited;
end;
function TDataList.Add(Item:TDataItem):integer;
var
pDOI:PDataObjectItem;
begin
New(pDOI);
pDOI^.DI := Item;
result := FList.Add(pDOI);
end;
function TDataList.Get(Index:integer):TDataItem;
begin
result := PDataItem(FList.Items[Index])^;
end;
procedure TDataList.Put(Index:integer;Item:TDataItem);
begin
PDataItem(FList.Items[Index])^ := Item;
end;
function TDataList.GetCount:integer;
begin
result := FList.Count;
end;
procedure TDataList.Clear;
var
i:integer;
begin
for i := 0 to FList.Count-1 do
Dispose(PDataObjectItem(FList.Items[i]));
FList.Clear;
end;
procedure TDataList.Delete(Index:integer);
begin
Dispose(PDataObjectItem(FList.Items[index]));
FList.Delete(index);
end;
procedure TDataList.Exchange(Index1,Index2:integer);
begin
FList.Exchange(index1,index2);
end;
function TDataList.IsEqual(Item1,Item2:TDataItem):Boolean;
begin
result := (Item1 = Item2);
end;
function TDataList.IndexOf(Item:TDataItem):integer;
var
i:integer;
begin
result := -1;
for i := 0 to FList.Count-1 do
if IsEqual(PDataItem(FList[i])^,Item) then begin
result := i;
break;
end;
end;
procedure TDataList.Insert(index:integer;Item:TDataItem);
var
pDOI:PDataObjectItem;
begin
New(pDOI);
pDOI^.DI := Item;
FList.Insert(index,pDOI);
end;
function TDataList.Remove(Item:TDataItem):integer;
begin
result := IndexOf(Item);
if result <> -1 then Delete(result);
end;
function TDataList.GetObjects(Index: Integer): TObject;
begin
result := PDataObjectItem(FList.Items[index])^.Obj;
end;
procedure TDataList.SetObjects(Index: Integer; const Value: TObject);
begin
PDataObjectItem(FList.Items[index])^.Obj := Value;
end;
end.
それでは、このクラスをテストするプログラムを以下に示す。
List 4
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, DataListUnit;
type
TForm1 = class(TForm)
ListBox1: TListBox;
ListBox2: TListBox;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
DL:TDataList;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
DL := TdataList.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DL.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i,iadd,value:integer;
begin
DL.Clear;
Randomize;
for i := 0 to 10 do begin
value := Random(100000);
iadd := DL.Add(value);
DL.Objects[iadd] := TObject(value);
ListBox1.Items.Add(Format('%2d : %5d',[i,value]));
end;
DL.Exchange(5,6);
for i := 0 to DL.Count-1 do
ListBox2.Items.Add(Format('%2d : %5d',[i,integer(DL.Objects[i])]));
end;
end.
実行時の様子を右に示す。ここでは、データ本体と同じ数値を TObject にキャストして保持している。
データの宣言を見てみよう。
type PDataItem = ^TDataItem; TDataItem = Integer; PDataObjectItem = ^TDataObjectItem; TDataObjectItem = record DI:TDataItem; Obj:TObject; end;
データ項目本体の宣言は前と同じであるが、新たに Obj:TObject; フィールドを追加した TDataObjectItem 型レコードを定義している。データ本体は、このレコード型の最初のフィールドになっていることは重要である。これは、ポインタからキャストするとき、PDataItem 型にキャストすると必ずデータ本体が得られるからである。Add メソッドをみてみよう。
function TDataList.Add(Item:TDataItem):integer; var pDOI:PDataObjectItem; begin New(pDOI); pDOI^.DI := Item; result := FList.Add(pDOI); end;
このように、Obj フィールドも含む PDataObjectItem 型として領域を確保している。項目の Get メソッドを見てみよう。
function TDataList.Get(Index:integer):TDataItem; begin result := PDataItem(FList.Items[Index])^; end;
というふうに、PDataItem 型にキャストして渡している。いっぽう、Objects[] 項目の Get メソッドは、
function TDataList.GetObjects(Index: Integer): TObject; begin result := PDataObjectItem(FList.Items[index])^.Obj; end;
ここでは PDataObjectItem 型にキャストしてからその逆参照の Obj フィールドを返している。新たに付け加えられた IsEqual メソッドは、二つの項目のデータ本体の内容が等しいかどうかを返す。
前節までにつくった TDataList クラスに Sort メソッドとディスクファイルに保存・読み出しの機能を追加しよう。全リストを以下に示す。
List 5
unit DataListUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, StdCtrls;
type
PDataItem = ^TDataItem;
TDataItem = Integer;
PDataObjectItem = ^TDataObjectItem;
TDataObjectItem = record
DI:TDataItem;
Obj:TObject;
end;
TDataList = class(TObject)
private
FList:TList;
function GetCount:integer;
function GetObjects(Index: Integer): TObject;
procedure SetObjects(Index: Integer; const Value: TObject);
protected
function Get(Index:integer):TDataItem;
procedure Put(Index:integer;Item:TDataItem);
public
constructor Create;
destructor Destroy; override;
function Add(Item:TDataItem):integer;
procedure Clear;
procedure Delete(Index:integer);
procedure Exchange(Index1,Index2:integer);
function IndexOf(Item:TDataItem):integer;
procedure Insert(index:integer;Item:TDataItem);
function Remove(Item:TDataItem):integer;
function IsEqual(Item1,Item2:TDataItem):Boolean;
procedure Sort(Compare:TListSortCompare);
procedure SaveToFile(const FileName: string);
procedure SaveToStream(Stream: TStream);
procedure LoadFromFile(const FileName: string);
procedure LoadFromStream(Stream: TStream);
procedure Assign(TDL:TDataList);
property Items[Index:Integer]:TDataItem read Get write Put; default;
property Objects[Index:Integer]:TObject read GetObjects write SetObjects;
property Count:integer read GetCount;
end;
implementation
{ TDataList }
constructor TDataList.Create;
begin
FList := TList.Create;
end;
destructor TDataList.Destroy;
begin
Clear;
FList.Free;
inherited;
end;
function TDataList.Add(Item:TDataItem):integer;
var
pDOI:PDataObjectItem;
begin
New(pDOI);
pDOI^.DI := Item;
result := FList.Add(pDOI);
end;
function TDataList.Get(Index:integer):TDataItem;
begin
result := PDataItem(FList.Items[Index])^;
end;
procedure TDataList.Put(Index:integer;Item:TDataItem);
begin
PDataItem(FList.Items[Index])^ := Item;
end;
function TDataList.GetCount:integer;
begin
result := FList.Count;
end;
procedure TDataList.Clear;
var
i:integer;
begin
for i := 0 to FList.Count-1 do
Dispose(PDataObjectItem(FList.Items[i]));
FList.Clear;
end;
procedure TDataList.Delete(Index:integer);
begin
Dispose(PDataObjectItem(FList.Items[index]));
FList.Delete(index);
end;
procedure TDataList.Exchange(Index1,Index2:integer);
begin
FList.Exchange(index1,index2);
end;
function TDataList.IsEqual(Item1,Item2:TDataItem):Boolean;
begin
result := (Item1 = Item2);
end;
function TDataList.IndexOf(Item:TDataItem):integer;
var
i:integer;
begin
result := -1;
for i := 0 to FList.Count-1 do
if IsEqual(PDataItem(FList[i])^,Item) then begin
result := i;
break;
end;
end;
procedure TDataList.Insert(index:integer;Item:TDataItem);
var
pDOI:PDataObjectItem;
begin
New(pDOI);
pDOI^.DI := Item;
FList.Insert(index,pDOI);
end;
function TDataList.Remove(Item:TDataItem):integer;
begin
result := IndexOf(Item);
if result <> -1 then Delete(result);
end;
function TDataList.GetObjects(Index: Integer): TObject;
begin
result := PDataObjectItem(FList.Items[index])^.Obj;
end;
procedure TDataList.SetObjects(Index: Integer; const Value: TObject);
begin
PDataObjectItem(FList.Items[index])^.Obj := Value;
end;
procedure TDataList.LoadFromFile(const FileName: string);
var
MS:TMemoryStream;
begin
MS := TMemoryStream.Create;
try
MS.LoadFromFile(FileName);
LoadFromStream(MS);
finally
MS.Free;
end;
end;
procedure TDataList.LoadFromStream(Stream: TStream);
var
RD:TReader;
Num,i:integer;
begin
Clear;
RD := TReader.Create(Stream,10);
try
Num := RD.ReadInteger;
for i := 0 to Num-1 do Add(RD.ReadInteger);
finally
RD.Free;
end;
end;
procedure TDataList.SaveToFile(const FileName: string);
var
MS:TMemoryStream;
begin
MS := TMemoryStream.Create;
try
SaveToStream(MS);
MS.SaveToFile(FileName);
finally
MS.Free;
end;
end;
procedure TDataList.SaveToStream(Stream: TStream);
var
WR:TWriter;
i:integer;
begin
WR := TWriter.Create(Stream,10);
try
WR.WriteInteger(Count);
WR.FlushBuffer;
for i := 0 to Count-1 do begin
WR.WriteInteger(Items[i]);
WR.FlushBuffer;
end;
finally
WR.Free;
end;
end;
procedure TDataList.Sort(Compare: TListSortCompare);
begin
FList.Sort(Compare);
end;
procedure TDataList.Assign(TDL: TDataList);
var
MS:TMemoryStream;
begin
Clear;
MS := TMemoryStream.Create;
try
TDL.SaveToStream(MS);
MS.Position := 0;
Self.LoadFromStream(MS);
finally
MS.Free;
end;
end;
end.
このクラスをテストするプログラムを以下に示す。
List 6
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, DataListUnit;
type
TForm1 = class(TForm)
ListBox1: TListBox;
ListBox2: TListBox;
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
DL1,DL2:TDataList;
procedure SetRandomData(DL:TDataList;Num:integer);
procedure DispDataList(LB:TListBox;DL:TDataList);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{ TForm1 }
procedure TForm1.DispDataList(LB: TListBox; DL: TDataList);
var
i:integer;
begin
for i := 0 to DL.Count-1 do
LB.Items.Add(Format('%2d : %5d',[i,DL[i]]));
end;
procedure TForm1.SetRandomData(DL: TDataList; Num: integer);
var
i:integer;
begin
Randomize;
for i := 0 to Num-1 do DL.Add(Random(100000));
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DL1 := TDataList.Create;
DL2 := TDataList.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DL1.Free;
DL2.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DL1.Clear;
SetRandomData(DL1,11);
ListBox1.Clear;
DispDataList(ListBox1,DL1);
DL1.SaveToFile(ExtractFilePath(ParamStr(0))+'test.dat');
DL2.LoadFromFile(ExtractFilePath(ParamStr(0))+'test.dat');
ListBox2.Clear;
DispDataList(ListBox2,DL2);
end;
function Shoujun(Item1,Item2:pointer):integer;
begin
result := PDataItem(Item1)^ - PDataItem(Item2)^;
end;
function Koujun(Item1,Item2:pointer):integer;
begin
result := PDataItem(Item2)^ - PDataItem(Item1)^;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
DL1.Clear;
SetRandomData(DL1,11);
ListBox1.Clear;
DispDataList(ListBox1,DL1);
DL1.Sort(Shoujun);
DL1.SaveToFile(ExtractFilePath(ParamStr(0))+'test.dat');
DL2.LoadFromFile(ExtractFilePath(ParamStr(0))+'test.dat');
ListBox2.Clear;
DispDataList(ListBox2,DL2);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
DL1.Clear;
SetRandomData(DL1,11);
ListBox1.Clear;
DispDataList(ListBox1,DL1);
DL1.Sort(Koujun);
DL2.Assign(DL1);
ListBox2.Clear;
DispDataList(ListBox2,DL2);
end;
end.
Button1Click では、DL1 にランダムな数値を設定し、ファイルに保存している。そして、DL2 はファイルからロードして ListBox2 に表示している。
Button2Click では、DL1 で昇順にソートした後ファイルに保存し、その後 DL2 が同じファイルを読み出して表示している。
Button3Click では、DL1 で降順にソートしてから、DL2 の Assign メソッドをつかって内容を DL2 にコピーしてからその内容を表示している。
それではコードを調べよう。まず、Sort を見てみよう。
procedure TDataList.Sort(Compare: TListSortCompare); begin FList.Sort(Compare); end;
このように、ソートは TList に丸投げしている。そのかわりに、比較関数だけはユーザにつくってもらわなければならない。いまのように、比較するフィールドが Integer 型のが一つだけである場合は、比較関数はほとんど一意に定まるのでクラスの中に隠蔽できるだろう。（メソッドにはできないが）しかし、複数のフィールドを持つレコード型では、どのフィールの値でソートするのかは、予めわからない。したがって、一般的には、比較関数はユーザが用意するのは妥当な実装だろう。ここでテストに使った実際の比較関数を以下に示す。
function Shoujun(Item1,Item2:pointer):integer; begin result := PDataItem(Item1)^ - PDataItem(Item2)^; end; function Koujun(Item1,Item2:pointer):integer; begin result := PDataItem(Item2)^ - PDataItem(Item1)^; end;
詳細は TList のヘルプを参照していただきたいが、渡された二つのポインタをデータ項目にキャストしてフィールドを比較するだけである。
つぎに、SaveToStream メソッドを見てみよう。
procedure TDataList.SaveToStream(Stream: TStream);
var
WR:TWriter;
i:integer;
begin
WR := TWriter.Create(Stream,10);
try
WR.WriteInteger(Count);
WR.FlushBuffer;
for i := 0 to Count-1 do begin
WR.WriteInteger(Items[i]);
WR.FlushBuffer;
end;
finally
WR.Free;
end;
end;
ここでは TWriter のインスタンスを作って、順番に WriteInteger で書き込んでいるだけである。最初にデータ項目の数を書き込む。１つのデータを書き込むたびに FlushBuffer しているので、BufSize は１０バイトもあれば十分である。これをつかうと SaveToFile は以下のようになる。
procedure TDataList.SaveToFile(const FileName: string);
var
MS:TMemoryStream;
begin
MS := TMemoryStream.Create;
try
SaveToStream(MS);
MS.SaveToFile(FileName);
finally
MS.Free;
end;
end;
ここでは、メモリーストリームをつくって、SaveToStream で書き込んでから、メモリーストリームの SaveToFile メソッドでファイルに保存している。一方、読み出しでは、LoadFromStream は
procedure TDataList.LoadFromStream(Stream: TStream);
var
RD:TReader;
Num,i:integer;
begin
Clear;
RD := TReader.Create(Stream,10);
try
Num := RD.ReadInteger;
for i := 0 to Num-1 do Add(RD.ReadInteger);
finally
RD.Free;
end;
end;
となっている。Clear してから、TReader オブジェクトを作成し、次々と読み込んで Add している。LoadFromFile は
procedure TDataList.LoadFromFile(const FileName: string);
var
MS:TMemoryStream;
begin
MS := TMemoryStream.Create;
try
MS.LoadFromFile(FileName);
LoadFromStream(MS);
finally
MS.Free;
end;
end;
となっている。二つにインスタンスの間で内容をコピーする Assign メソッドを見てみよう。
procedure TDataList.Assign(TDL: TDataList);
var
MS:TMemoryStream;
begin
Clear;
MS := TMemoryStream.Create;
try
TDL.SaveToStream(MS);
MS.Position := 0;
Self.LoadFromStream(MS);
finally
MS.Free;
end;
end;
これは、相手にストリームに書き込んでもらい、それを LoadFromStream で自分に読み込んでいる。
以上のように、TStream の派生クラスをつかって、TWriter と TReader のメソッドを使えば簡単にコードが書ける。TWriter と TReader はストリームに対して、Integer だけでなく、string や Char、Boolean、Single などたいていの型をアクセスできるメソッドを持っているので、だいたいどんなレコード型でも使えるだろう。
さて、これまで作ってきた integer 型のリストではたいしたありがたみはない。これがなぜ汎用リストクラスなのだろうか？ それはこのクラスの実装のしかたに依っている。前節のコードを見ると分かるように、実際にどんな型のリストであるか、具体的に保持している項目の内容に依存するコードは、次の３つのメソッドだけである。
１）IsEqual ： データ項目のすべての内容が等しいかどうか ２）LoadFromStream ： 項目をストリームからロードする ３）SaveToStream ： 項目をストリームに書き込む
したがって、この３つのメソッドを書き換えるだけでどんな型でもそのリストを動的に管理するクラスを簡単に作ることができる。ここでは、具体的に
type PDataItem = ^TDataItem; TDataItem = record No:Integer; Sei:string; Mei:string; ID:integer; end;
のような、整数型が二つ、string 型を二つフィールドとするレコード型のリストを作ってみよう。以下に全コードを示す。
List 7
unit DataListUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, StdCtrls;
type
PDataItem = ^TDataItem;
TDataItem = record
No:Integer;
Sei:string;
Mei:string;
ID:integer;
end;
PDataObjectItem = ^TDataObjectItem;
TDataObjectItem = record
DI:TDataItem;
Obj:TObject;
end;
TDataList = class(TObject)
private
FList:TList;
function GetCount:integer;
function GetObjects(Index: Integer): TObject;
procedure SetObjects(Index: Integer; const Value: TObject);
protected
function Get(Index:integer):TDataItem;
procedure Put(Index:integer;Item:TDataItem);
public
constructor Create;
destructor Destroy; override;
function Add(Item:TDataItem):integer;
procedure Clear;
procedure Delete(Index:integer);
procedure Exchange(Index1,Index2:integer);
function IndexOf(Item:TDataItem):integer;
procedure Insert(index:integer;Item:TDataItem);
function Remove(Item:TDataItem):integer;
function IsEqual(Item1,Item2:TDataItem):Boolean;
procedure Sort(Compare:TListSortCompare);
procedure SaveToFile(const FileName: string);
procedure SaveToStream(Stream: TStream);
procedure LoadFromFile(const FileName: string);
procedure LoadFromStream(Stream: TStream);
procedure Assign(TDL:TDataList);
property Items[Index:Integer]:TDataItem read Get write Put; default;
property Objects[Index:Integer]:TObject read GetObjects write SetObjects;
property Count:integer read GetCount;
end;
implementation
{ TDataList }
constructor TDataList.Create;
begin
FList := TList.Create;
end;
destructor TDataList.Destroy;
begin
Clear;
FList.Free;
inherited;
end;
function TDataList.Add(Item:TDataItem):integer;
var
pDOI:PDataObjectItem;
begin
New(pDOI);
pDOI^.DI := Item;
result := FList.Add(pDOI);
end;
function TDataList.Get(Index:integer):TDataItem;
begin
result := PDataItem(FList.Items[Index])^;
end;
procedure TDataList.Put(Index:integer;Item:TDataItem);
begin
PDataItem(FList.Items[Index])^ := Item;
end;
function TDataList.GetCount:integer;
begin
result := FList.Count;
end;
procedure TDataList.Clear;
var
i:integer;
begin
for i := 0 to FList.Count-1 do
Dispose(PDataObjectItem(FList.Items[i]));
FList.Clear;
end;
procedure TDataList.Delete(Index:integer);
begin
Dispose(PDataObjectItem(FList.Items[index]));
FList.Delete(index);
end;
procedure TDataList.Exchange(Index1,Index2:integer);
begin
FList.Exchange(index1,index2);
end;
function TDataList.IsEqual(Item1,Item2:TDataItem):Boolean; ///////
begin
result := (Item1.No = Item2.No) and
(Item1.Sei = Item2.Sei) and
(Item1.Mei = Item2.Mei) and
(Item1.ID = Item2.ID);
end;
function TDataList.IndexOf(Item:TDataItem):integer;
var
i:integer;
begin
result := -1;
for i := 0 to FList.Count-1 do
if IsEqual(PDataItem(FList[i])^,Item) then begin
result := i;
break;
end;
end;
procedure TDataList.Insert(index:integer;Item:TDataItem);
var
pDOI:PDataObjectItem;
begin
New(pDOI);
pDOI^.DI := Item;
FList.Insert(index,pDOI);
end;
function TDataList.Remove(Item:TDataItem):integer;
begin
result := IndexOf(Item);
if result <> -1 then Delete(result);
end;
function TDataList.GetObjects(Index: Integer): TObject;
begin
result := PDataObjectItem(FList.Items[index])^.Obj;
end;
procedure TDataList.SetObjects(Index: Integer; const Value: TObject);
begin
PDataObjectItem(FList.Items[index])^.Obj := Value;
end;
procedure TDataList.LoadFromFile(const FileName: string);
var
MS:TMemoryStream;
begin
MS := TMemoryStream.Create;
try
MS.LoadFromFile(FileName);
LoadFromStream(MS);
finally
MS.Free;
end;
end;
procedure TDataList.LoadFromStream(Stream: TStream); ///////
var
RD:TReader;
Num,i:integer;
DI:TDataItem;
begin
Clear;
RD := TReader.Create(Stream,1000);
try
Num := RD.ReadInteger;
for i := 0 to Num-1 do begin
DI.No := RD.ReadInteger;
DI.Sei := RD.ReadString;
DI.Mei := RD.ReadString;
DI.ID := RD.ReadInteger;
Add(DI);
end;
finally
RD.Free;
end;
end;
procedure TDataList.SaveToFile(const FileName: string);
var
MS:TMemoryStream;
begin
MS := TMemoryStream.Create;
try
SaveToStream(MS);
MS.SaveToFile(FileName);
finally
MS.Free;
end;
end;
procedure TDataList.SaveToStream(Stream: TStream); //////
var
WR:TWriter;
i:integer;
begin
WR := TWriter.Create(Stream,1000);
try
WR.WriteInteger(Count);
WR.FlushBuffer;
for i := 0 to Count-1 do begin
WR.WriteInteger(Items[i].No);
WR.WriteString(Items[i].Sei);
WR.WriteString(Items[i].Mei);
WR.WriteInteger(Items[i].ID);
WR.FlushBuffer;
end;
finally
WR.Free;
end;
end;
procedure TDataList.Sort(Compare: TListSortCompare);
begin
FList.Sort(Compare);
end;
procedure TDataList.Assign(TDL: TDataList);
var
MS:TMemoryStream;
begin
Clear;
MS := TMemoryStream.Create;
try
TDL.SaveToStream(MS);
MS.Position := 0;
Self.LoadFromStream(MS);
finally
MS.Free;
end;
end;
end.
どうだろうか。前節まででつくったリストクラスをコピペして、三つのメソッドを書き換えるのは、ほんの数分でできてしまうだろう。それでは、このリストクラスをテストするプログラムを以下にしめす。
List 8
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, DataListUnit, Buttons, ExtCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
ListBox2: TListBox;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Panel1: TPanel;
SpeedButton1: TSpeedButton;
Label1: TLabel;
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
DL1,DL2:TDataList;
procedure SetData(DL:TDataList);
procedure DispDataList(LB:TListBox;DL:TDataList);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{ TForm1 }
procedure TForm1.DispDataList(LB: TListBox; DL: TDataList);
var
i:integer;
begin
for i := 0 to DL.Count-1 do
LB.Items.Add(Format('%2d : %s %s ID = $%x',
[DL[i].No,DL[i].Sei,DL[i].Mei,DL[i].ID]));
end;
procedure TForm1.SetData(DL: TDataList);
var
i:integer;
DI:TDataItem;
begin
for i := 0 to ComponentCount-1 do begin
DI.No := i;
DI.Sei := Components[i].ClassName;
DI.Mei := Components[i].Name;
if Components[i] is TWinControl then
DI.ID := TWinControl(Components[i]).Handle
else
DI.ID := 0;
DL.Add(DI);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DL1 := TDataList.Create;
DL2 := TDataList.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DL1.Free;
DL2.Free;
end;
function NoShoujun(Item1,Item2:pointer):integer;
begin
result := PDataItem(Item1)^.No - PDataItem(Item2)^.No;
end;
function NoKoujun(Item1,Item2:pointer):integer;
begin
result := PDataItem(Item2)^.No - PDataItem(Item1)^.No;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DL1.Clear;
SetData(DL1);
ListBox1.Clear;
DispDataList(ListBox1,DL1);
DL1.Sort(NoKoujun);
DL1.SaveToFile(ExtractFilePath(ParamStr(0))+'test.dat');
DL2.LoadFromFile(ExtractFilePath(ParamStr(0))+'test.dat');
ListBox2.Clear;
DispDataList(ListBox2,DL2);
end;
function IDShoujun(Item1,Item2:pointer):integer;
begin
result := PDataItem(Item1)^.ID - PDataItem(Item2)^.ID;
end;
function IDKoujun(Item1,Item2:pointer):integer;
begin
result := PDataItem(Item2)^.ID - PDataItem(Item1)^.ID;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
DL1.Clear;
SetData(DL1);
ListBox1.Clear;
DispDataList(ListBox1,DL1);
DL1.Sort(IDShoujun);
DL1.SaveToFile(ExtractFilePath(ParamStr(0))+'test.dat');
DL2.LoadFromFile(ExtractFilePath(ParamStr(0))+'test.dat');
ListBox2.Clear;
DispDataList(ListBox2,DL2);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
DL1.Clear;
SetData(DL1);
ListBox1.Clear;
DispDataList(ListBox1,DL1);
DL2.Assign(DL1);
ListBox2.Clear;
DispDataList(ListBox2,DL2);
end;
end.
実行時の様子を右図にしめした。データを与えるのが面倒なので、ここでは Form1 が保持している Components[] 配列の Name と ClassName と TWinControl の派生クラスの場合は、そのハンドル値をセットしている。Button1Click では、DL1 のリストを No フィールドで降順にソートしてから、ファイルを通して DL2 にコピーしている。Button2Click では、ID フィールドで昇順にソートしてから、やはりファイルをとおして DL2 にコピーしている。Button3Click では Assign メソッドをテストしている。
以上のように、前節までにつくったクラスは、簡単に改造して、どんな型でも、またレコード型でも動的にリストを管理するクラスをつくるためのテンプレートになっていることが分かるだろう。
前節までで、整数や文字列、論理型、実数およびそれらをフィールドとしてもつレコード型の動的リストを保持する汎用リストクラスを作成した。これらは、どれも、各々のデータがひとかたまりのメモリイメージとして存在し、実際にはそれを指すポインタをリストとして保持していた。このことの利点は、データの大きさによらずに、並べ替えや削除などがポインタだけを参照して統一的に行うことができることである。しかし、データそのものは、メモリにただ存在するだけであり、それ自身は自分を知らない。したがって、データの内容を変更するたびに、そのリストを保持するクラスのメソッドを書き換えなければならなかった。もし、おのおののデータ項目がクラスのインスタンスであったら、自分をどのように扱うか知っているので、リストを保持するクラスのメソッドを書き換える必要がなくなるだろう。たとえば、ストリームに自分の内容を書き込むのは、データ自身がその方法を知っている方が望ましいだろう。
ここでは、データ項目をクラスとして定義し、そのインスタンスのリストを動的に保持するクラスを作成してみよう。VCL にはすでに TObjectList クラスがあって、いろいろなクラスのインスタンスを管理することができる。したがって、このクラスから派生して、単一データクラスのリストを保持するクラスを作成してみよう。クラスのインスタンスをデータ項目とすると膨大なメモリが消費されるわけではない。おのおののクラスは、exe イメージのなかにメソッド部分が含まれ、インスタンスをつくるとインスタンス毎に異なるデータ部分、つまりフィールド変数部分と VMT へのポインタだけがメモリに割り当てられる。したがって、等価なレコード型に比較してオーバヘッドは３２ビットだけである。データのサイズが大きければ大きいほど、このオーバヘッドは無視できる。実際、以下に示すように、項目をクラスにした方が明らかに実装は簡単で保守も容易である。それではさっそくやってみよう。あらたにユニットファイルを作成し、以下のような内容にする。
List 9
unit DataObjectListUnit;
interface
uses
SysUtils, Contnrs;
type
TDataItemBase = class(TObject)
end;
TDataItem = class(TDataItemBase)
public
No:integer;
Name:string;
end;
TDataList = class(TObjectList)
private
protected
function GetItem(Index: Integer): TDataItem;
procedure SetItem(Index: Integer; AObject: TDataItem);
public
function Add(AObject: TDataItem): Integer;
function Remove(AObject: TDataItem): Integer;
function IndexOf(AObject: TDataItem): Integer;
procedure Insert(Index: Integer; AObject: TDataItem);
property Items[Index: Integer]: TDataItem read GetItem write SetItem; default;
end;
implementation
{ TDataList }
function TDataList.Add(AObject: TDataItem): Integer;
begin
Result := inherited Add(AObject);
end;
function TDataList.GetItem(Index: Integer): TDataItem;
begin
Result := TDataItem(inherited Items[Index]);
end;
function TDataList.IndexOf(AObject: TDataItem): Integer;
begin
Result := inherited IndexOf(AObject);
end;
procedure TDataList.Insert(Index: Integer; AObject: TDataItem);
begin
inherited Insert(Index, AObject);
end;
function TDataList.Remove(AObject: TDataItem): Integer;
begin
Result := inherited Remove(AObject);
end;
procedure TDataList.SetItem(Index: Integer; AObject: TDataItem);
begin
inherited Items[Index] := AObject;
end;
end.
データ項目のクラスの宣言を見てみよう。
TDataItemBase = class(TObject) end; TDataItem = class(TDataItemBase) public No:integer; Name:string; end;
このように、TObject - TDataItemBase - TDataItem のように派生して、ここでは integer 型と string 型のデータをフィールドとして持つクラスを定義している。新たなメソッドはないので実装部はない。リストクラスを見てみよう。
TDataList = class(TObjectList) private protected function GetItem(Index: Integer): TDataItem; procedure SetItem(Index: Integer; AObject: TDataItem); public function Add(AObject: TDataItem): Integer; function Remove(AObject: TDataItem): Integer; function IndexOf(AObject: TDataItem): Integer; procedure Insert(Index: Integer; AObject: TDataItem); property Items[Index: Integer]: TDataItem read GetItem write SetItem; default; end;
TDataList は TObjectList から派生している。つまり、
TObject - TList - TObjectList - TDataList
という派生関係である。TList は型なしポインタのリストを保持するクラスである。TObjectList は、ポインタを TObject にキャストしているだけである。この実装コードを見習って、TObject を TDataItem にキャストするだけで目的のクラスができあがる。実際、実装コードは、TObject を扱っているメソッドを TDataItem にキャストしているだけである。これは、上位クラスのインスタンスには、下位クラスを代入できることを利用している。このクラスをテストするプログラムを以下のように作成した。
List 10
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, DataObjectListUnit, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
DL:TDataList;
procedure DisplayData;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
i:integer;
DI:TDataItem;
begin
DL := TDataList.Create(true);
for i := 0 to 10 do begin
DI := TDataItem.Create;
DI.No := i;
DI.Name := Format('DataItem%.2d',[i]);
DL.Add(DI);
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DL.Free;
end;
procedure TForm1.DisplayData;
var
i:integer;
begin
Memo1.Clear;
for i := 0 to DL.Count-1 do
Memo1.Lines.Add(Format('No %2d - %s',[DL[i].No,DL[i].Name]));
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DisplayData;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
DL.Exchange(2,9);
DisplayData;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
DI:TDataItem;
begin
DI := TDataItem.Create;
DI.No := 77;
DI.Name := 'Inserted Here';
DL.Exchange(2,9);
DL.Insert(7,DI);
DisplayData;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
DL.Delete(7);
DisplayData;
end;
function NoKoujun(Item1, Item2: Pointer):integer;
begin
result := TDataItem(Item2).No - TDataItem(Item1).No;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
DL.Sort(NoKoujun);
DisplayData;
end;
end.
実行して、Button1 を押すと、保持しているデータの一覧を Memo1 に表示する。
つぎに、Button2 を押すと２番目と９番目の項目を入れ替える。ここでは上位クラスのメソッドを試していることになる。
Button3 を押すと、入れ替えをもう一度おこなって元に戻した後で新たに項目をつくって７番目に挿入している。
Button4 を押して、挿入した項目を削除し、Button5 を押して No フィールドで降順にソートしている。
以上のように、なんだか拍子抜けするくらい簡単に、データを保持するクラスのインスタンスを項目とするリストクラスを作成することができた。次節では、これにファイルアクセスの機能を追加する。このとき、項目がクラスであることの便利さをさらに実感できるだろう。
レコード型のリストのところでやったように、ファイルの読み書きや Assign() によるコピーを実現するためには、ストリームに読み書きできればよい。項目がクラスのインスタンスであれば、自分でストリームに読み書きする方法を実装できるだろう。つまり、保持したいデータの具体的な内容に依存するコードは、データ項目自身でもつことができる。したがって、リストクラスは、完全に項目の具体的な内容と無縁にすることができる。このことの意味は、OOP の興味以上に実際的な理由からも重要である。ユーザは、汎用リストクラスの実装を変更する必要がなく、自由にデータ項目の内容を変更できるからである。それではやってみよう。前節のユニットに少し変更を加える。
List 11
unit DataObjectListUnit;
interface
uses
SysUtils, Classes, Contnrs;
type
TDataItemBase = class(TObject)
public
Data:TObject;
procedure WriteToStream(Stream: TStream;WR:TWriter);virtual;abstract;
procedure ReadFromStream(Stream: TStream;RD:TReader);virtual;abstract;
end;
TDataItem = class(TDataItemBase)
public
No:integer;
Name:string;
procedure WriteToStream(Stream: TStream;WR:TWriter);override;
procedure ReadFromStream(Stream: TStream;RD:TReader);override;
class function GetBufferSize:integer;
end;
TDataList = class(TObjectList)
private
protected
function GetItem(Index: Integer): TDataItem;
procedure SetItem(Index: Integer; AObject: TDataItem);
public
function Add(AObject: TDataItem): Integer;
function Remove(AObject: TDataItem): Integer;
function IndexOf(AObject: TDataItem): Integer;
procedure Insert(Index: Integer; AObject: TDataItem);
procedure SaveToFile(const FileName: string);
procedure SaveToStream(Stream: TStream);
procedure LoadFromFile(const FileName: string);
procedure LoadFromStream(Stream: TStream);
procedure Assign(TDL: TDataList);
property Items[Index: Integer]: TDataItem read GetItem write SetItem; default;
end;
implementation
{ TDataList }
function TDataList.Add(AObject: TDataItem): Integer;
begin
Result := inherited Add(AObject);
end;
procedure TDataList.Assign(TDL: TDataList);
var
MS:TMemoryStream;
begin
Clear;
MS := TMemoryStream.Create;
try
TDL.SaveToStream(MS);
MS.Position := 0;
Self.LoadFromStream(MS);
finally
MS.Free;
end;
end;
function TDataList.GetItem(Index: Integer): TDataItem;
begin
Result := TDataItem(inherited Items[Index]);
end;
function TDataList.IndexOf(AObject: TDataItem): Integer;
begin
Result := inherited IndexOf(AObject);
end;
procedure TDataList.Insert(Index: Integer; AObject: TDataItem);
begin
inherited Insert(Index, AObject);
end;
procedure TDataList.LoadFromFile(const FileName: string);
var
MS:TMemoryStream;
begin
MS := TMemoryStream.Create;
try
MS.LoadFromFile(FileName);
LoadFromStream(MS);
finally
MS.Free;
end;
end;
procedure TDataList.LoadFromStream(Stream: TStream);
var
Num,i:integer;
RD:TReader;
DI:TDataItem;
begin
Clear;
RD := TReader.Create(Stream,TDataItem.GetBufferSize);
Num := RD.ReadInteger;
for i := 0 to Num-1 do begin
DI := TDataItem.Create;
DI.ReadFromStream(Stream,RD);
Add(DI)
end;
RD.Free;
end;
function TDataList.Remove(AObject: TDataItem): Integer;
begin
Result := inherited Remove(AObject);
end;
procedure TDataList.SaveToFile(const FileName: string);
var
MS:TMemoryStream;
begin
MS := TMemoryStream.Create;
try
SaveToStream(MS);
MS.SaveToFile(FileName);
finally
MS.Free;
end;
end;
procedure TDataList.SaveToStream(Stream: TStream);
var
i:integer;
WR:TWriter;
begin
WR := TWriter.Create(Stream,TDataItem.GetBufferSize);
WR.WriteInteger(Count);
WR.FlushBuffer;
for i := 0 to Count-1 do begin
Items[i].WriteToStream(Stream,WR);
WR.FlushBuffer;
end;
WR.Free;
end;
procedure TDataList.SetItem(Index: Integer; AObject: TDataItem);
begin
inherited Items[Index] := AObject;
end;
{ TDataItem }
class function TDataItem.GetBufferSize: integer;
begin
result := 1000;
end;
procedure TDataItem.ReadFromStream(Stream: TStream;RD:TReader);
begin
No := RD.ReadInteger;
Name := RD.readString;
end;
procedure TDataItem.WriteToStream(Stream: TStream;WR:TWriter);
begin
WR.WriteInteger(No);
WR.WriteString(Name);
end;
end.
データ項目の宣言を見てみよう。
TDataItemBase = class(TObject) public Data:TObject; procedure WriteToStream(Stream: TStream;WR:TWriter);virtual;abstract; procedure ReadFromStream(Stream: TStream;RD:TReader);virtual;abstract; end; TDataItem = class(TDataItemBase) public No:integer; Name:string; procedure WriteToStream(Stream: TStream;WR:TWriter);override; procedure ReadFromStream(Stream: TStream;RD:TReader);override; class function GetBufferSize:integer; end;
TDataItemBase では、まず、Data:TObject; フィールドを追加して、このクラスの下位クラスでは、必ず Data フィールドを持つようにしている。また、具体的なデータ内容をストリームに読み書きする二つの抽象メソッドを追加して、下位クラスにはその実装を強制している。TDataItem クラスでは、この抽象メソッドを override して実装している。そのほかに、読み書きに伴う TReader と TWriter のバッファサイズを指定するクラスメソッドを持っている。実装部を見てみよう。
class function TDataItem.GetBufferSize: integer; begin result := 1000; end; procedure TDataItem.ReadFromStream(Stream: TStream;RD:TReader); begin No := RD.ReadInteger; Name := RD.readString; end; procedure TDataItem.WriteToStream(Stream: TStream;WR:TWriter); begin WR.WriteInteger(No); WR.WriteString(Name); end;
GetBufferSize はクラスメソッドであり、一つの項目を読み書きするのに十分なバッファサイズを設定する。メモリをケチらず大きめに設定しておいた方がよいだろう。ストリームへの読み書きは、ストリームオブジェクトと TReader または TWriter のインスタンスを受け取って、具体的な内容を読み書きする。
TDataList クラスの SaveToStream() を見てみよう。
procedure TDataList.SaveToStream(Stream: TStream);
var
i:integer;
WR:TWriter;
begin
WR := TWriter.Create(Stream,TDataItem.GetBufferSize);
WR.WriteInteger(Count);
WR.FlushBuffer;
for i := 0 to Count-1 do begin
Items[i].WriteToStream(Stream,WR);
WR.FlushBuffer;
end;
WR.Free;
end;
このように、TDataItem が指定するサイズでバッファを確保した TWriter オブジェクトをつくり、それを項目に渡して、項目自身に書き込ませている。このこと以外は、レコード型の汎用リストのときと同様である。このコードには、データ項目の具体的な内容に依存している部分がないことを再度強調しておきたい。
このクラスをテストするプログラムを以下のようにつくった。
List 12
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, DataObjectListUnit, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
DL:TDataList;
procedure DisplayData(TDL:TDataList);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
i:integer;
DI:TDataItem;
begin
DL := TDataList.Create(true);
for i := 0 to 10 do begin
DI := TDataItem.Create;
DI.No := i;
DI.Name := Format('DataItem%.2d',[i]);
DL.Add(DI);
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DL.Free;
end;
procedure TForm1.DisplayData(TDL:TDataList);
var
i:integer;
begin
Memo1.Lines.BeginUpdate;
Memo1.Clear;
for i := 0 to TDL.Count-1 do
Memo1.Lines.Add(Format('No %2d - %s',[TDL[i].No,TDL[i].Name]));
Memo1.Lines.EndUpdate;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DisplayData(DL);
end;
function NoKoujun(Item1, Item2: Pointer):integer;
begin
result := TDataItem(Item2).No - TDataItem(Item1).No;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
TDL:TDataList;
begin
DL.Sort(NoKoujun);
TDL := TDataList.Create(true);
try
TDL.Assign(DL);
DisplayData(TDL);
finally
TDL.Free;
end;
end;
function NoShoujun(Item1, Item2: Pointer):integer;
begin
result := TDataItem(Item1).No - TDataItem(Item2).No;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
TDL:TDataList;
begin
DL.Sort(NoShoujun);
DL.SaveToFile('c:\Test.dat');
TDL := TDataList.Create(true);
try
TDL.LoadFromFile('c:\Test.dat');
DisplayData(TDL);
finally
TDL.Free;
end;
end;
end.
実行して Button1 を押すと一覧が Memo1 に表示される。
Button2 を押すと、降順でソートした内容を新たにつくったオブジェクトに Assign() メソッドでコピーし、その内容を表示する。
Button3 を押すと、昇順にソートしてから、ファイルに保存し、新たなオブジェクトがそのファイルからロードしてその内容を表示する。
以上のように、オブジェクトをデータ項目として、そのリストを動的に保持する汎用クラスを作成した。
本章では、単純型や文字列、およびそれらの組み合わせで構成されたデータを、レコード型のリストとして保持する汎用クラスと、クラスのオブジェクトのリストとして保持する汎用クラスを作成した。実際につくってみると、データ項目がクラスであることは、拡張・変更に対する柔軟性だけではなく、汎用性という意味からでも、レコード型リストの場合より優れているように感じられる。integer 型や Boolean 型のような単純な項目のリストでも、筆者ならオブジェクトのリストとして扱いたい。このような小さなデータをクラスのインスタンスで包むのは馬鹿らしい、と感じる方も多いだろう。それでも、なおかつ、オブジェクト項目の汎用性と柔軟性の方が重要であるように感じるのです。