☆TListのSortの使用方法

TListのSortを使うと簡単に並び替えができます。
本と著者を管理する簡単なクラスを作って試してみます。

unit TListSortSampleClass;

interface

uses
  Windows, SysUtils, Classes;

type
  TMyBook = class(TObject)
  private
    FBookName: String;
    FAuthor: String;
  public
    constructor Create(BookName, Author: String);
  published
    property BookName: String read FBookName write FBookName;
    property Author: String read FAuthor write FAuthor;
  end;

  TMyBookList = class(TObject)
  private
    FList: TList;                                       { リスト }
    function GetData(Index: Integer): TMyBook;          { 読み込み }
    procedure SetData(Index: Integer; MyBook: TMyBook); { 書き込み }
    function GetCount: Integer;                         { リストのカウント数 }
  protected
    procedure Error;                                    { エラーの表示 }
  public
    constructor Create;                                 { 生成 }
    destructor Destroy; override;                       { 破棄 }
    procedure Clear;                                    { 消去 }
    function Add(MyBook: TMyBook): Integer;             { 追加 }
    procedure Sort;                                     { 並べ替え }
    property Items[Index: Integer]: TMyBook read GetData write SetData; default;
  published
    property Count: Integer read GetCount;              { リストのカウント数 }
  end;

implementation

{ TMyBook }

constructor TMyBook.Create(BookName, Author: String);
begin
  inherited Create;
  FBookName:= BookName;
  FAuthor := Author;
end;

{ TMyBookList }

// 生成
constructor TMyBookList.Create;
begin
  FList := TList.Create;
end;

// 破棄
destructor TMyBookList.Destroy;
begin
  Clear;
  FList.Free;
  inherited Destroy;
end;

// 消去
procedure TMyBookList.Clear;
var
  I: Integer;
begin
  for I := 0 to FList.Count -1 do
    TMyBook(FList[I]).Free;
  FList.Clear;
end;

// 追加
function TMyBookList.Add(MyBook: TMyBook): Integer;
begin
  Result := FList.Add(MyBook);
end;

// エラー処理
procedure TMyBookList.Error;
begin
  raise Exception.Create('インデックスがリストの範囲を超えています');
end;

// リストからの取得
function TMyBookList.GetData(Index: Integer): TMyBook;
begin
  if (Index < 0) or (Index >= FList.Count) then Error;
  Result := TMyBook(FList[Index]);
end;

// リストへの設定
procedure TMyBookList.SetData(Index: Integer; MyBook: TMyBook);
begin
  if (Index < 0) or (Index >= FList.Count) then Error;
  FList[Index] := MyBook;
end;

// リストのカウント数
function TMyBookList.GetCount: Integer;
begin
  Result := FList.Count;
end;

ソート部分のプログラムです。
function ListSortCompare(Item1,Item2: Pointer): Integer; 
var
  S1, S2: String;
begin
  S1 := TMyBook(Item1).BookName;
  S2 := TMyBook(Item2).BookName;
  Result := AnsiCompareText(S1, S2);
end;

procedure TMyBookList.Sort;
begin
  FList.Sort(@ListSortCompare);
end;

end.

上記のリストを利用するサンプルです。
適当にデータを入力して、試してみて下さい。
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, TListSortSampleClass;

type
  TForm1 = class(TForm)
    Edit1: TEdit;  // 本の名前
    Edit2: TEdit;  // 著者
    Memo1: TMemo;
    Memo2: TMemo;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    MyBookList: TMyBookList;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  MyBookList:= TMyBookList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MyBookList.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  MyBookList.Add(TMyBook.Create(Edit1.Text, Edit2.Text));
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  I: Integer;
begin
  // 並べ替え前のデータ
  for I := 0 to MyBookList.Count - 1 do
    Memo1.Lines.Add(MyBookList[I].BookName);

  // 並べ替え後のデータ
  MyBookList.Sort;
  for I := 0 to MyBookList.Count - 1 do
    Memo2.Lines.Add(MyBookList[I].BookName);
end;

end.

Memo1には入力順に、Memo2には、並べ替えされたデータが設定されていると思います。
わざわざクイックソートのプログラムを書かなくても簡単に並べ替えができるので便利ですね。

|

☆TListを使ったリスト No3


それではMySampleClassesが、きちんと動作しているかどうか確かめてみます。
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, MySampleClasses;

type

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    MyBookList1, MyBookList2: TMyBookList;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  MyBookList1 := TMyBookList.Create;
  MyBookList2 := TMyBookList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MyBookList1.Free;
  MyBookList2.Free;
end;

// test1
procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
  S1, S2: String;  
begin
  MyBookList1.Clear;
  MyBookList2.Clear;

  // MyBookList1に追加
  MyBookList1.Add(TMyBook.Create('Delphi オブジェクト指向プログラミング','塚越一雄'));
  MyBookList1.Add(TMyBook.Create('delphi-fan','hiderin'));
  MyBookList1.Add(TMyBook.Create('コンピュータ・アルゴリズム事典','奥村晴彦'));

  // MyBookList1から削除
  MyBookList1.Delete(1); // delphi-fan

  // MyBookList1に挿入
  MyBookList1.Insert(0,TMyBook.Create('Delphi6プログラミングバイブル','Marco Cantu'));

  // MyBookList2にMyBookList1のデータをコピーする。
  MyBookList2.Assign(MyBookList1);

  // MyBookList2にきちんとコピーされたか確認する。
  Memo1.Lines.Clear;
  for I := 0 to MyBooKList2.Count - 1 do
  begin
    S1 := MyBookList2[I].BookName;
    S2 := MyBookList2[I].Author;
    Memo1.Lines.Add(Concat(S1, #9, S2));
  end;
end;

// test2
procedure TForm1.Button2Click(Sender: TObject);
var
  I: Integer;
  S1, S2: String;
begin
  // SaveToFile---Stream関係をチェックする。
   MyBookList2.SaveToFile('c:\aaa.dat');

  // LoadFromFile---Stream関係をチェックする。
  MyBookList1.LoadFromFile('c:\aaa.dat');

  // ファイルから読み込みできたかチェックします。
  Memo1.Lines.Clear;
  for I := 0 to MyBooKList1.Count - 1 do
  begin
    S1 := MyBookList1[I].BookName;
    S2 := MyBookList1[I].Author;
    Memo1.Lines.Add(Concat(S1, #9, S2));
  end;
end;

end.
一応、動作しているようですね。でも、『TListを使ったリスト No1~No3』まで夜中に一気に適当に書いたので、どこかに間違いがあるかも知れないので気をつけて下さい(笑)

又、専用の追加メソッドを作れば、いちいちTMyBookを生成させなくてもBookNameとAuthorを追加できますね。 いろいろな方法、いろいろな形で作ることができるので、アプリに最適なものを考えていけばよいと思います。

TListを使ったリスト No1
TListを使ったリスト No2
TListを使ったリスト No3

|

☆TListを使ったリスト No2

前回、作成したTHRBase、THRBaseListを使って本と著者名を管理するリストを作ってみます。 又、リストをファイルに読み書きできるように拡張します。
わざわざ、HRBaseClassesというユニットを作ったのは、このように必要な部分のみを拡張して使うことを意図していたからです。
unit MySampleClasses;

interface

uses
  SysUtils, Classes, HRBaseClasses;

type
  TMyBook = class(THRBase)
  private
    FBookName: String;
    FAuthor: String;
  public
    constructor Create(BookName, Author: String);
    procedure SaveToStream(var Stream: TStream);
    procedure LoadFromStream(Stream: TStream);
    procedure Assign(Source: TPersistent); override;
  published
    property BookName: String read FBookName write FBookName;
    property Author: String read FAuthor write FAuthor;
  end;

  TMyBookList = class(THRBaseList)
  private
    function GetData(Index: Integer): TMyBook;
    procedure SetData(Index: Integer; MyBook: TMyBook);
  public
    procedure SaveToStream(var Stream: TStream);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToFile(const FileName: String);
    procedure LoadFromFile(const FileName: String);
    procedure Assign(Source: TPersistent); override;
    property Items[Index: Integer]: TMyBook
      read GetData write SetData; default;
  end;

implementation

// Streamに文字列を書き込みます。
procedure WriteStringToStream(var Stream: TStream; Value: String);
var
  I: Integer;
begin
  with Stream do
  begin
    I := Length(Value);
    WriteBuffer(I, SizeOf(Integer));
    WriteBuffer(PChar(Value)^, I);
  end;
end;

// Streamから文字列に読み込みます。
function ReadStringFromStream(const Stream: TStream): String;
var
  I: Integer;
begin
  with Stream do
  begin
    ReadBuffer(I, SizeOf(Integer));
    SetLength(Result, I);
    ReadBuffer(PChar(Result)^, I);
  end;
end;

{ TMyBook }

constructor TMyBook.Create(BookName, Author: String);
begin
  inherited Create;
  FBookName:= BookName;
  FAuthor := Author;
end;

procedure TMyBook.Assign(Source: TPersistent);
begin
  if (Source is TMyBook) then
  begin
    BookName:= (Source as TMyBook).BookName;
    Author := (Source as TMyBook).Author;
    Exit;
  end;
  inherited Assign(Source);
end;

procedure TMyBook.LoadFromStream(Stream: TStream);
begin
  FBookName := ReadStringFromStream(Stream);
  FAuthor := ReadStringFromStream(Stream);
end;

procedure TMyBook.SaveToStream(var Stream: TStream);
begin
  WriteStringToStream(Stream, FBookName);
  WriteStringToStream(Stream, FAuthor);
end;

{ TMyBookList }

procedure TMyBookList.SetData(Index: Integer; MyBook: TMyBook);
begin
  List[Index] := MyBook;
end;

function TMyBookList.GetData(Index: Integer): TMyBook;
begin
  Result := TMyBook(List[Index]);
end;

procedure TMyBookList.Assign(Source: TPersistent);
var
  I: Integer;
  MyBook: TMyBook;
begin
  if (Source is TMyBookList) then
  begin
    Clear;
    for I := 0 to (Source as TMyBookList).Count -1 do
    begin
      MyBook := TMyBook.Create('','');
      MyBook.Assign((Source as TMyBookList)[I]);
      Add(MyBook);
    end;
    Exit;
  end;
  inherited Assign(Source);
end;

procedure TMyBookList.LoadFromStream(Stream: TStream);
var
  I, K: Integer;
  MyBook: TMyBook;
begin
  Clear;
  Stream.ReadBuffer(K, SizeOf(Integer));

  for I := 0 to K -1 do
  begin
    MyBook := TMyBook.Create('','');
    MyBook.LoadFromStream(Stream);
    Add(MyBook);
  end;
end;

procedure TMyBookList.SaveToStream(var Stream: TStream);
var
  I: Integer;
begin
  I := Count;
  Stream.WriteBuffer(I, SizeOf(Integer));

  for I := 0 to Count -1 do
    TMyBook(List[I]).SavetoStream(Stream);
end;

procedure TMyBookList.SaveToFile(const FileName: String);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate or fmShareExclusive);
  try
    Stream.Seek(0, soFromBeginning);
    SaveToStream(TStream(Stream));
  finally
    Stream.Free;
  end;
end;

procedure TMyBookList.LoadFromFile(const FileName: String);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    Stream.Seek(0, soFromBeginning);
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;


end.

TListを使ったリスト No1
TListを使ったリスト No2
TListを使ったリスト No3

|

☆TListを使ったリスト No1

その昔、ポインタを繋いだり、繋ぎ変えたり、ガベージコレクションさせたりと誰もが自作リストでクラス(当時はレコード型だったかな)を管理していました。しかしDelphiには、TListという汎用性のあるリストが用意されていますので、わざわざ可読性の悪いリストを自作する必要はないです。

さて、そのTListですがポインタを扱うので、次のように型キャストが必要になります。
procedure TForm1.Button1Click(Sender: TObject);
var
  List: TList;
  I: Integer;
begin
  List := TList.Create;
  try
    List.Add(TStringList.Create);
    TStringList(List[0]).Text := 'delphi-fan';
    Memo1.Lines.Assign(TStringList(List[0]));
  finally
    for I := 0 to List.Count - 1 do
      TStringList(List[I]).Free;
    List.Free;
  end;
end;

これだとやはり可読性がよくない!ということで、特定のクラスを管理するリストを作ってみたいと思います。 人によっては、MyList = class(TList)という形で作られておられますが、 この場合、TListのメンバーに直接アクセスできる、すなわちポインタとしても扱えるためどんな型も 管理することができてしまいます。となるとバグが潜む可能性が出てきますよね。
(この方法を否定しているわけではないです)
ということで、私はTListをprivateなフィールドにしたクラスが好きです(笑)

せっかくなので拡張性を持たせたサンプルを作っていきたいと思います。
リストの読み書きを汎用ポインタではなく、THRBaseクラスで行えるようにしています。
unit HRBaseClasses;

interface

uses
  SysUtils, Classes;

type

  THRBase = class(TPersistent);

  THRBaseList = class(TPersistent)
  private
    FList: TList;                                       { リスト }
    function GetData(Index: Integer): THRBase;          { 読み込み }
    procedure SetData(Index: Integer; HRBase: THRBase); { 書き込み }
    function GetCount: Integer;                         { リストのカウント数 }
  protected
    procedure Error;                                    { エラーの表示 }
    property List[Index: Integer]: THRBase              { リストへのアクセス }
      read GetData write SetData; default;
  public
    constructor Create;                                 { 生成 }
    destructor Destroy; override;                       { 破棄 }
    procedure Clear;                                    { 消去 }
    function Add(HRBase: THRBase): Integer;             { 追加 }
    procedure Insert(Index: Integer; HRBase: THRBase);  { 挿入 }
    procedure Delete(Index: Integer);                   { 削除 }
    procedure Assign(Source: TPersistent); override;    { Assign }
  published
    property Count: Integer read GetCount;              { リストのカウント数 }
  end;

implementation

{ THRBaseList }

// 生成
constructor THRBaseList.Create;
begin
  FList := TList.Create;
end;

// 破棄
destructor THRBaseList.Destroy;
begin
  Clear;
  FList.Free;
  inherited Destroy;
end;

// 消去
procedure THRBaseList.Clear;
var
  I: Integer;
begin
  for I := 0 to FList.Count -1 do
    THRBase(FList[I]).Free;
  FList.Clear;
end;

// 追加
function THRBaseList.Add(HRBase: THRBase): Integer;
begin
  Result := FList.Add(HRBase);
end;

// 挿入
procedure THRBaseList.Insert(Index: Integer; HRBase: THRBase);
begin
  FList.Insert(Index, HRBase);
end;

// 削除
procedure THRBaseList.Delete(Index: Integer);
begin
  THRBase(FList[Index]).Free;
  FList.Delete(Index);
end;

// エラー処理
procedure THRBaseList.Error;
begin
  raise Exception.Create('インデックスがリストの範囲を超えています');
end;

// リストからの取得
function THRBaseList.GetData(Index: Integer): THRBase;
begin
  if (Index < 0) or (Index >= FList.Count) then Error;
  Result := THRBase(FList[Index]);
end;

// リストへの設定
procedure THRBaseList.SetData(Index: Integer; HRBase: THRBase);
begin
  if (Index < 0) or (Index >= FList.Count) then Error;
  FList[Index] := HRBase;
end;

// リストのカウント数
function THRBaseList.GetCount: Integer;
begin
  Result := FList.Count;
end;

// Assign
procedure THRBaseList.Assign(Source: TPersistent);
var
  I: Integer;
  HRBase: THRBase;
begin
  if (Source is THRBaseList) then
  begin
    Clear;
    for I := 0 to (Source as THRBaseList).Count -1 do
    begin
      HRBase := THRBase.Create;
      HRBase.Assign((Source as THRBaseList)[I]);
      Add(HRBase);
    end;
    Exit;
  end;
  inherited Assign(Source);
end;

end.

なぜTObjectではなくて、TPersistentから継承しているのか、疑問に思われる方も多いかも知れませんね。 その理由は、私が作るリストの中では、TPersistentのAssignという仮想メソッドを再定義することが多いからです(笑)
※procedure Assign(Source: TPersistent); override; という部分ですね。

今回は、単純なクラスを拡張していくという目的で作っているので、少し回りくどい処理になっているかも知れません。 HRBaseClassesを取り込んだ形でいきなり「TListを使ったリスト No2」のMySampleClassesにあるクラスを作ることも多いです。

TListを使ったリスト No1
TListを使ったリスト No2
TListを使ったリスト No3

|