Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2007年04月25日] [更新 2013年02月18日]　Delphi サンプルプログラム集
790_ファイル一覧・仮想リストビュー
動作確認等 Windows 7 U64(SP1) + Delphi XE Pro
790_ListView.zip　[4,916 KB]　2013年02月18日版 (EXE 同梱)






ファイル一覧・仮想リストビュー


[780_ファイル情報の取得と日時・属性の変更等] で，リストビュー (TListView) コンポーネントを使用してファイルの情報を表示しました．しかし，これらのサンプルコードでは，ファイルの数が多くなると表示までに時間がかかるようになります．

この現象は，ListView の各項目，Item に値をセットする時間が問題となるためです．そこで，ファイル情報に限らず，表示が必要となった時に，表示に必要な分だけのデータを Item にセットするか，データはメモリの他の場所，例えば TList 等に保持し，表示の分だけを Item にセットすれば，高速表示が期待できます．この方式は仮想リストビュー (Virtual ListView) と呼ばれています．
TListView や TListBox には，このためのイベントとして，TList には OnData，OnDataFind が，TListView には OnDataHint，OnData，OnDataFind が用意されています．OnDataHint イベントは，Item に表示が必要となった時に 1 回だけ，また OnData イベントは表示に必要な各 Item の描画ごとに発生します．
以下のサンプルコードはこれらのイベントを使用しています．





01_ファイル一覧・仮想リストビュー -ファイル名のみ


このサンプルコードでは，ファイルの情報を保持するために，TFileListItem というクラスに必要なプロパティを設けて，そこに格納しています．この様な用途にレコード体も使用されることがありますが，クラス型は，レコード体を発展させた Delphi 特有のものです．Delphi はこのクラスを導入し，その継承という機能が大きな特長です．
このページのサンプルコードでは，このデータ格納用のクラスの定義はほとんど同じです，また，他のサンプルプログラム集でも名前は違っていますが，クラス型を用しているものがあります．


図1
設計時画面
図2
実行結果
  • ほとんど一瞬で表示
  • これは Windows のシステムフォルダ内

リスト1
仮想リストビューでフォルダ内のファイル一覧表示 
unit ListView01Unit;

interface

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

type
  TplDataListItem=class;

  TplDataList=class(TList)
  protected
    function Get(Index: Integer): TplDataListItem;
    procedure Put(Index: Integer; Item: TplDataListItem);
  public
    destructor Destroy; override;
    procedure Clear; virtual;
    function Add(Item: TplDataListItem): Integer;
    function IndexOf(Item: TplDataListItem): Integer;
    function Remove(Item: TplDataListItem): Integer;
    property Items[Index: Integer]: TplDataListItem read Get write Put; default;
  end;

  TplDataListItem =class(TObject)
  private
    FFileName  : String;
    FFileSize  : Integer;
    FFileDate  : TDateTime;
  public
  published
    //特にpublishedなプロパティにしなくても利用できるが，将来の拡張のため
    property FileName  : String    read FFileName  write FFileName;
    property FileSize  : Integer   read FFileSize  write FFileSize;
    property FileDate  : TDateTime read FFileDate  write FFileDate;
  end;

  TFileListItem = class(TplDataListItem);

  TForm1 = class(TForm)
    ListView1: TListView;
    Panel2: TPanel;
    Button1: TButton;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure ListView1Data(Sender: TObject; Item: TListItem);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
    BasePath : String;
    FFileList  : TplDataList;
    procedure SetFilesListToItems(APath: String);
    function FileTimeToDateTime(ATime:TFileTime): TDateTime;
    function GetWindowsSystemDir: String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses FileCtrl,ShellAPI;

{$R *.dfm}

{ TplDataList }

//=============================================================================
//  ファイル情報を格納するTplDataListの関数とメソッド類
//  TListのこれらの関数，メソッドの引数や戻値はPointerであるが，ここでは
//  TplDataListItemにキャストするために再定義　　
//  ClearメソッドはTplDataListのオブジェクト破棄のコードを追加するため再定義
//=============================================================================
destructor TplDataList.Destroy;
var
  i : Integer;
begin
  for i := 0 to Count - 1 do begin
    Items[i].Free;
  end;
  inherited;
end;

//-----------------------------------------------------------------------------
procedure TplDataList.Clear;
var
  i : Integer;
begin
  for i := 0 to Count - 1 do begin
    Items[i].Free;
  end;
  inherited;
end;

//-----------------------------------------------------------------------------
procedure TplDataList.Put(Index: Integer; Item: TplDataListItem);
begin
  inherited Items[Index] := Item;
end;

//-----------------------------------------------------------------------------
function TplDataList.Get(Index: Integer): TplDataListItem;
begin
  Result := TplDataListItem(inherited Items[Index]);
end;

//-----------------------------------------------------------------------------
function TplDataList.Add(Item: TplDataListItem): Integer;
begin
  Result := inherited Add(Item);
end;
//-----------------------------------------------------------------------------
function TplDataList.IndexOf(Item: TplDataListItem): Integer;
begin
  Result := inherited IndexOf(Item);
end;

//-----------------------------------------------------------------------------
function TplDataList.Remove(Item: TplDataListItem): Integer;
begin
  Result := inherited Remove(Item);
end;

//=============================================================================
//  開始時にFFileListを生成
//  ListView1のOwnerDataプロパティをTrue
//             RowSelectをTrue
//             ViewStyleをvsReport
//  にしてある
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  FFileList := TplDataList.Create;
  BasePath  := GetWindowsSystemDir;
end;

//=============================================================================
//  終了時はFFileListを解放
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FFileList);
end;

//=============================================================================
//  検索開始
//  BasePathは検索対象フォルダ名(グローバル変数)
//
//  SelectDirectoryの使用にはusesにFileCtrlが必要
//  Delphi 2007以降では，TFileOpenDialogを使用した方がいいかも知れない
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Panel1.Caption:='';
  if SelectDirectory('検索フォルダ指定', '', BasePath, []) then begin
    BasePath :=IncludeTrailingPathDelimiter(BasePath);

    //ListViewのItemsをクリアしてからFFileList.Clear
    ListView1.Items.Clear;
    FFileList.Clear;
    ListView1.MultiSelect:=False;
    ListView1.Items.BeginUpdate;
    SetFilesListToItems(BasePath);
    ListView1.Items.Count:=FFileList.Count;
    ListView1.Items.EndUpdate;
  end;
  Panel1.Caption := '該当ファイル数 : ' + IntToStr(FFileList.Count);
end;

//=============================================================================
//  APathで指定するフォルダ内のファイルの情報をFFileListの各Itemに格納
//=============================================================================
procedure TForm1.SetFilesListToItems(APath: String);
var
  SearchRec : TSearchRec;
  FItem     : TplDataListItem;
begin
  if FindFirst(APath + '*.*', faAnyFile, SearchRec) = 0 then begin
    repeat
      if ((SearchRec.Name <> '..') and (SearchRec.Name <> '.')) then begin
        FItem:=TplDataListItem.Create;
        //ファイル名を追加
        FItem.FileName := SearchRec.Name;
        if SearchRec.Attr = faDirectory then begin
          FItem.FileSize := 0;
        end else begin
          //ファイルサイズを追加
          FItem.FileSize := SearchRec.FindData.nFileSizeLow;
        end;
        //最終更新日を追加
        FItem.FileDate := FileTimeToDateTime(SearchRec.FindData.ftLastWriteTime);
        //Itemをリストに追加
        FFileList.Add(FItem);
        Application.ProcessMessages;
      end;
    until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
  end;
end;

//=============================================================================
//  ListView1のOnDataイベント
//  ListViewの各Itemの描画が必要となった場合に発生
//  ListViewのItemとSubItemに値をセットする
//  このイベントはListView1.OwnerData:=True;でないと機能しない
//=============================================================================
procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
var
  FileSize  : Integer;
  ADateTime : TDateTime;
begin
  if Item.Index > FFileList.Count then exit;

  Item.Caption := FFileList.Items[Item.Index].FileName;

  FileSize := FFileList.Items[Item.Index].FileSize;
  if FileSize = 0 then begin
    Item.SubItems.Add('');
  end else begin
    FileSize := (FileSize div 1024)+1;
    Item.SubItems.Add(FormatFloat('###,##0 KB', FileSize));
  end;
  ADateTime := FFileList.Items[Item.Index].FileDate;
  Item.SubItems.Add(FormatDateTime('yyyy/mm/dd hh:nn', ADateTime));
end;

//=============================================================================
//  TFileTime型の値をDelphiのTDateTime型に変換する関数
//=============================================================================
function TForm1.FileTimeToDateTime(ATime: TFileTime): TDateTime;
var
  SystemTime : TSystemTime;
  TempTime   : TFileTime;
begin
  try
    //FileTime形式(世界協定時刻)を地域にあわせる
    FileTimeToLocalFileTime(ATime, TempTime);
    //FileTime形式をSystemTime形式にする
    FileTimeToSystemTime(TempTime, SystemTime);
    //SystemTime形式をDelphiのTDateTime形式に変換
    Result := SystemTimeToDateTime(SystemTime);
  except
    Result := 0;
  end;
end;

//=============================================================================
//  Windowsのシステムディレクトリのパスを取得(テスト用)
//  ファイルが多く存在するので表示速度のテストにいいかも知れない
//=============================================================================
function TForm1.GetWindowsSystemDir: String;
var
  Str : String;
  Len : Integer;
begin
  Len := GetSystemDirectory(nil, 0);
  SetLength(Str, Len);
  GetSystemDirectory(PChar(Str), Len);
  Result :=IncludeTrailingPathDelimiter(Str);
end;

end.



02_ファイル一覧・仮想リストビュー - ファイルのアイコンを表示


ファイルの一覧表示となれば，ファイルのアイコンも表示したくなります．このサンプルでは，シェル関数を用いてファイルのアイコンを取得し，データ格納用クラスのプロパティに代入しています．このアイコンを OnData イベントで各 Item の imageIndex にセットします．
この方式は，ファイル数が多いとアイコンの取得に時間がかかることがわかります．


図3
設計時画面
  • アイコン格納用の TImageList を配置
図4
ファイル情報取得中
  • アイコンの取得に時間がかかる
図5
実行結果
  • Windows のシステムフォルダ内

リスト2
ファイルのアイコンを表示 
unit ListView02Unit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, ImgList;

type
  TplDataListItem = class;

  TplDataList = class(TList)
  protected
    function Get(Index: Integer): TplDataListItem;
    procedure Put(Index: Integer; Item: TplDataListItem);
  public
    destructor Destroy; override;
    procedure Clear; virtual;
    function Add(Item: TplDataListItem): Integer;
    function IndexOf(Item: TplDataListItem): Integer;
    function Remove(Item: TplDataListItem): Integer;
    property Items[Index: Integer]: TplDataListItem read Get write Put; default;
  end;

  TplDataListItem = class(TObject)
  private
    FFileName  : String;
    FFileSize  : Integer;
    FFileDate  : TDateTime;
  public
  published
    //特にpublishedなプロパティにしなくても利用できるが，将来の拡張のため
    property FileName  : String    read FFileName  write FFileName;
    property FileSize  : Integer   read FFileSize  write FFileSize;
    property FileDate  : TDateTime read FFileDate  write FFileDate;
  end;

  TFileListItem = class(TplDataListItem);

  TForm1 = class(TForm)
    ListView1: TListView;
    ImageList1: TImageList;
    Panel2: TPanel;
    Button1: TButton;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure ListView1Data(Sender: TObject; Item: TListItem);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
    BasePath : String;
    FFileList  : TplDataList;
    procedure SetFilesListToItems(APath: String);
    function FileTimeToDateTime(ATime: TFileTime): TDateTime;
    function GetWindowsSystemDir: String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses FileCtrl,ShellAPI;

{$R *.dfm}

{ TFileList }

//=============================================================================
//  ファイル情報を格納するTplDataListの関数とメソッド類
//  TListのこれらの関数，メソッドの引数や戻値はPointerであるが，ここでは
//  TplDataListItemにキャストするために再定義　　
//  ClearメソッドはTplDataListのオブジェクト破棄のコードを追加するため再定義
//=============================================================================
destructor TplDataList.Destroy;
var
  i : Integer;
begin
  for i := 0 to Count - 1 do begin
    Items[i].Free;
  end;
  inherited;
end;

//-----------------------------------------------------------------------------
procedure TplDataList.Clear;
var
  i : Integer;
begin
  for i := 0 to Count - 1 do begin
    Items[i].Free;
  end;
  inherited;
end;

//-----------------------------------------------------------------------------
procedure TplDataList.Put(Index: Integer; Item: TplDataListItem);
begin
  inherited Items[Index] := Item;
end;

//-----------------------------------------------------------------------------
function TplDataList.Get(Index: Integer): TplDataListItem;
begin
  Result := TplDataListItem(inherited Items[Index]);
end;

//-----------------------------------------------------------------------------
function TplDataList.Add(Item: TplDataListItem): Integer;
begin
  Result := inherited Add(Item);
end;
//-----------------------------------------------------------------------------
function TplDataList.IndexOf(Item: TplDataListItem): Integer;
begin
  Result := inherited IndexOf(Item);
end;

//-----------------------------------------------------------------------------
function TplDataList.Remove(Item: TplDataListItem): Integer;
begin
  Result := inherited Remove(Item);
end;

//=============================================================================
//  開始時にFFileListを生成
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  FFileList := TplDataList.Create;
  BasePath  := GetWindowsSystemDir;
end;

//=============================================================================
//  終了時はFFileListを解放
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FFileList);
end;

//=============================================================================
//  検索開始
//  BasePathは検索対象フォルダ名(グローバル変数)
//
//  SelectDirectoryの使用にはusesにFileCtrlが必要
//  Delphi 2007以降では，TFileOpenDialogを使用した方がいいかも知れない
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Panel1.Caption := '';

  if SelectDirectory('検索フォルダ指定', '', BasePath, []) then begin
    BasePath := IncludeTrailingPathDelimiter(BasePath);

    //ListViewのItemsをクリアしてからFFileList.Clear
    ListView1.Items.Clear;
    FFileList.Clear;
    ListView1.MultiSelect := False;
    ListView1.Items.BeginUpdate;
    SetFilesListToItems(BasePath);
    ListView1.Items.Count := FFileList.Count;
    ListView1.Items.EndUpdate;
  end;
  Panel1.Caption:='該当ファイル数 : ' + IntToStr(FFileList.Count);
end;

//=============================================================================
//  APathで指定するフォルダ内のファイルの情報をFFileListの各Itemに格納
//=============================================================================
procedure TForm1.SetFilesListToItems(APath: String);
var
  SearchRec : TSearchRec;
  FItem     : TFileListItem;
  SHInfo    : TSHFileInfo;
  Icon      : TIcon;
begin
  //これがないとアイコンの周囲に黒い影が(WindowsXPで確認)
  ImageList1.BkColor := ListView1.Color;

  if FindFirst(APath + '*.*', faAnyFile, SearchRec) = 0 then begin
    repeat
      if ((SearchRec.Name <> '..') and (SearchRec.Name <> '.')) then begin
        FItem := TFileListItem.Create;
        //ファイル名を追加
        FItem.FileName := SearchRec.Name;
        if SearchRec.Attr = faDirectory then begin
          FItem.FileSize := 0;
        end else begin
          //ファイルサイズを追加
          FItem.FileSize := SearchRec.FindData.nFileSizeLow;
        end;
        //最終更新日を追加
        FItem.FileDate := FileTimeToDateTime(SearchRec.FindData.ftLastWriteTime);
        //ファイルのアイコンを追加
        Icon := TIcon.Create;
        try
          SHGetFileInfo(PChar(APath+SearchRec.Name),
                        0,
                        ShInfo,
                        SizeOf(ShInfo),
                        SHGFI_SMALLICON or SHGFI_ICON or SHGFI_SHELLICONSIZE);
          Icon.Handle := ShInfo.hIcon;
          ImageList1.AddIcon(Icon) ;
        finally
          Icon.Free;
        end;
        //Itemをリストに追加
        FFileList.Add(FItem);
        Application.ProcessMessages;
      end;
    until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
  end;
end;

//=============================================================================
//  ListView1のOnDataイベント
//  ListViewの各Itemの描画が必要となった場合に発生
//  ListViewのItemとSubItemに値をセットする
//  このイベントはListView1.OwnerData:=True;でないと機能しない
//=============================================================================
procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
var
  FileSize  : Integer;
  ADateTime : TDateTime;
begin
  if Item.Index > FFileList.Count then exit;

  Item.Caption := FFileList.Items[Item.Index].FileName;
  FileSize := FFileList.Items[Item.Index].FileSize;

  if FileSize = 0 then begin
    Item.SubItems.Add('');
  end else begin
    FileSize := (FileSize div 1024) + 1;
    Item.SubItems.Add(FormatFloat('###,##0 KB', FileSize));
  end;
  ADateTime := FFileList.Items[Item.Index].FileDate;
  Item.SubItems.Add(FormatDateTime('yyyy/mm/dd hh:nn', ADateTime));
  Item.ImageIndex:=Item.Index;
end;

//=============================================================================
//  TFileTime型の値をDelphiのTDateTime型に変換する関数
//=============================================================================
function TForm1.FileTimeToDateTime(ATime: TFileTime): TDateTime;
var
  SystemTime : TSystemTime;
  TempTime   : TFileTime;
begin
  try
    //FileTime形式(世界協定時刻)を地域にあわせる
    FileTimeToLocalFileTime(ATime, TempTime);
    //FileTime形式をSystemTime形式にする
    FileTimeToSystemTime(TempTime, SystemTime);
    //SystemTime形式をDelphiのTDateTime形式に変換
    Result:=SystemTimeToDateTime(SystemTime);
  except
    Result:=0;
  end;
end;

//=============================================================================
//  Windowsのシステムディレクトリのパスを取得(テスト用)
//  ファイルが多く存在するので表示速度のテストにいいかも知れない
//=============================================================================
function TForm1.GetWindowsSystemDir: String;
var
  Str : String;
  Len : Integer;
begin
  Len := GetSystemDirectory(nil, 0);
  SetLength(Str, Len);
  GetSystemDirectory(PChar(Str), Len);
  Result :=IncludeTrailingPathDelimiter(Str);
end;

end.



03_ファイル一覧・仮想リストビュー - システムのイメージリスト使用


アイコンの取得と，そのアイコンを TImageList に格納するのに時間がかかっています．
そこで，Windows のシステムに用意されているイメージリストを使用することにします．ファイルのフルパス名に該当するアイコンインデックスを，このシステムのイメージリストから取得し，各 Item にこのイメージインデックスをセットします．この方式では，イメージリストにアイコンをセットする分だけ高速化が期待できます．

このサンプルでは，カラムをクリックするとソートするようにしてします．トグル動作となっています．どのカラムのソートを実行したかを内部で記憶し，別のフォルダのリスト表示の際にそのソートを実行して表示するようになっています．


図6
設計時画面
  • アイコン格納用の TImageList は使用しない
図7
実行結果
  • かなりの高速表示となっている
  • ファイル名取得後に名前でソート

リスト3
ファイルのアイコンをシステムイメージから取得 
unit ListView03Unit;

interface

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

type
  TplDataListItem = class;

  TplDataList = class(TList)
  protected
    function Get(Index: Integer): TplDataListItem;
    procedure Put(Index: Integer; Item: TplDataListItem);
  public
    destructor Destroy; override;
    procedure Clear; virtual;
    function Add(Item: TplDataListItem): Integer;
    function IndexOf(Item: TplDataListItem): Integer;
    function Remove(Item: TplDataListItem): Integer;
    property Items[Index: Integer]: TplDataListItem read Get write Put; default;
  end;

  TplDataListItem = class(TObject)
  private
    FFileName   : String;
    FFileSize   : Integer;
    FFileDate   : TDateTime;
    FIconIndex  : Integer;
    FFileAttrib : Integer;
  public
  published
    //特にpublishedなプロパティにしなくても利用できるが，将来の拡張のため
    property FileName   : String    read FFileName   write FFileName;
    property FileSize   : Integer   read FFileSize   write FFileSize;
    property FileDate   : TDateTime read FFileDate   write FFileDate;
    property IconIndex  : Integer   read FIconIndex  write FIconIndex;
    property FileAttrib : Integer   read FFileAttrib write FFileAttrib;
  end;

  TFileListItem = class(TplDataListItem);

  TForm1 = class(TForm)
    Panel2: TPanel;
    Panel3: TPanel;
    Button1: TButton;
    Panel1: TPanel;
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ListView1Data(Sender: TObject; Item: TListItem);
    procedure ListView1DataHint(Sender: TObject; StartIndex,
      EndIndex: Integer);
    procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn);
  private
    { Private 宣言 }
    BasePath : String;
    FFileList  : TplDataList;
    procedure SetFilesListToItems(APath: String);
    function FileTimeToDateTime(ATime:TFileTime): TDateTime;
    function GetWindowsSystemDir: String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses FileCtrl, ShellAPI, ShlObj, CommCtrl, Math, DateUtils;

{$R *.dfm}

var
  //ソート関係の変数
  //SortColumnIndexはソートするカラム番号ごとにソート順を保持
  //SortColumnIndexはソートするカラムのインデックス
  SortColum       : array[0..2] of integer;
  SortColumnIndex : Integer;

{ TplDataList }

//=============================================================================
//  ファイル情報を格納するTplDataListの関数とメソッド類
//  TListのこれらの関数，メソッドの引数や戻値はPointerであるが，ここでは
//  TplDataListItemにキャストするために再定義　　
//  ClearメソッドはTplDataListのオブジェクト破棄のコードを追加するため再定義
//=============================================================================
destructor TplDataList.Destroy;
var
  i : Integer;
begin
  for i := 0 to Count - 1 do begin
    Items[i].Free;
  end;
  inherited;
end;

//-----------------------------------------------------------------------------
procedure TplDataList.Clear;
var
  i : Integer;
begin
  for i := 0 to Count - 1 do begin
    Items[i].Free;
  end;
  inherited;
end;

//-----------------------------------------------------------------------------
procedure TplDataList.Put(Index: Integer; Item: TplDataListItem);
begin
  inherited Items[Index] := Item;
end;

//-----------------------------------------------------------------------------
function TplDataList.Get(Index: Integer): TplDataListItem;
begin
  Result := TplDataListItem(inherited Items[Index]);
end;

//-----------------------------------------------------------------------------
function TplDataList.Add(Item: TplDataListItem): Integer;
begin
  Result := inherited Add(Item);
end;

//-----------------------------------------------------------------------------
function TplDataList.IndexOf(Item: TplDataListItem): Integer;
begin
  Result := inherited IndexOf(Item);
end;

//-----------------------------------------------------------------------------
function TplDataList.Remove(Item: TplDataListItem): Integer;
begin
  Result := inherited Remove(Item);
end;

//=============================================================================
//  FFileList(TList)用のソートのコールバック関数
//  Item1>Item2の時<0 Item10 Item1=Item2の時0を返すと昇順
//  オブジェクトを持たないTListの昇順ソートはSortメソッドを実行すればよい
//  降順やオブジェクトでソートする場合はコールバック関数を使用する必要がある
//=============================================================================
function SortFFileList(Item1, Item2: Pointer): Integer;
var
  Index1 : Integer;
  Index2 : Integer;
  Int1   : Int64;
  Int2   : Int64;
  Str1   : String;
  Str2   : String;
  Date1  : TDateTime;
  Date2  : TDateTime;
  Dir1   : Boolean;
  Dir2   : Boolean;
begin
  Index1 := Form1.FFileList.IndexOf(Item1);
  Index2 := Form1.FFileList.IndexOf(Item2);

  Result := 0;
  case SortColumnIndex of
  //名前
  0:
    begin
      Dir1 := (Form1.FFileList[Index1].FileAttrib and faDirectory) <> 0;
      Dir2 := (Form1.FFileList[Index2].FileAttrib and faDirectory) <> 0;
      Str1 := Form1.FFileList[Index1].FileName;
      Str2 := Form1.FFileList[Index2].FileName;

      //どちらもフォルダかどちらもフォルダでない場合
      if (Dir1 and Dir2) or not(Dir1 or Dir2) then begin
        Result := SortColum[SortColumnIndex] * CompareStr(Str1, Str2);
      end else
      //Item1に該当するのがフォルダの場合
      if Dir1 then begin
        Result:= -SortColum[SortColumnIndex];
      end else
      //Item2に該当するのがフォルダの場合
      if Dir2 then begin
        Result := SortColum[SortColumnIndex];
      end;
    end;
  //サイズ
  1:
    begin
      Int1 := Form1.FFileList[Index1].FFileSize;
      Int2 := Form1.FFileList[Index2].FFileSize;
      Result := SortColum[SortColumnIndex] * CompareValue(Int1, Int2);
    end;
  //更新日時
  2:
    begin
      Dir1  := (Form1.FFileList[Index1].FileAttrib and faDirectory) <> 0;
      Dir2  := (Form1.FFileList[Index2].FileAttrib and faDirectory) <> 0;

      Date1 := Form1.FFileList[Index1].FileDate;
      Date2 := Form1.FFileList[Index2].FileDate;
      //どちらもフォルダかどちらもフォルダでない場合
      if (Dir1 and Dir2) or not(Dir1 or Dir2) then begin
        Result := SortColum[SortColumnIndex] * CompareDate(Date1, Date2);
      end else
      //Item1に該当するのがフォルダの場合
      if Dir1 then begin
        Result := -SortColum[SortColumnIndex];
      end else
      //Item2に該当するのがフォルダの場合
      if Dir2 then begin
        Result := SortColum[SortColumnIndex];
      end;
    end;
  end;
end;

//=============================================================================
//  フォーム作成時
//  (1)ファイルリスト格納用のFFileListの生成
//  (2)システムのイメージリストをListViewに関連付ける
//     SHGetFileInfoの取得アイコンにSHGFI_SYSICONINDEXを付加するのがミソ
//
//  仮想リストビューではスクロールの度に再描画が行われるのでチラツキことがある
//  そこでListView1.DoubleBuffered:=True;としている
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  SHFileInfo    : TSHFileInfo ;
  ImgListHandle : THandle;
  i             : Integer;
begin
  BasePath := GetWindowsSystemDir;

  ListView1.DoubleBuffered := True;
  FFileList := TplDataList.Create;

  //コモンコントロールのイニシャライズ
  InitCommonControls() ;
  //システムのイメージリストのハンドルを取得
  ImgListHandle := SHGetFileInfo(
                     '',
                     0,
                     SHFileInfo,
                     SizeOf(SHFileInfo),
                     SHGFI_ICON or SHGFI_SMALLICON or SHGFI_SYSICONINDEX);
  ListView_SetImageList(ListView1.Handle, ImgListHandle, LVSIL_SMALL);

  //ソートで使用する配列値に代入
  //ソート対象カラムの初期値は0(名前のカラム)
  SortColumnIndex := 0;
  for i := 0 to Length(SortColum) - 1 do begin
    SortColum[i] := 1;
  end;
end;

//=============================================================================
//  使い終わったら解放
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FFileList);
end;

//=============================================================================
//  検索開始
//  SelectDirectoryの使用にはusesにFileCtrlが必要
//  Delphi 2007以降では，TFileOpenDialogを使用した方がいいかも知れない
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Panel1.Caption := '';
  if SelectDirectory('検索フォルダ指定', '', BasePath, []) then begin
    BasePath := IncludeTrailingPathDelimiter(BasePath);
    Update;

    //ListViewのItemsをクリアしてからFFileList.Clear
    ListView1.Items.Clear;
    FFileList.Clear;
    ListView1.MultiSelect := False;

    SetFilesListToItems(BasePath);

    ListView1.Items.Count := FFileList.Count;
    //ソート
    if FFileList.Count > 0 then begin
      FFileList.Sort(Addr(SortFFileList));
    end;
  end;
  Panel1.Caption:='該当ファイル数 : ' + IntToStr(FFileList.Count);
end;

//=============================================================================
//  APathで指定するフォルダ内のファイルの情報をFFileListの各Itemに格納
//  アイコンはOnDataHintイベント内で表示分だけ取得する
//=============================================================================
procedure TForm1.SetFilesListToItems(APath: String);
var
  SearchRec  : TSearchRec;
  FItem      : TFileListItem;
  Attrib     : Integer;
begin
  if FindFirst(APath + '*.*', faAnyFile, SearchRec) = 0 then begin
    repeat
      if ((SearchRec.Name <> '..') and (SearchRec.Name <> '.')) then begin
        FItem := TFileListItem.Create;
        FItem.IconIndex := -1;
        //属性を取得
        Attrib := SearchRec.Attr;
        //ファイル名を記録
        FItem.FileName := SearchRec.Name;
        //ファイル属性を記録
        FItem.FileAttrib := Attrib;
        if BOOL( Attrib and faDirectory) then begin
          FItem.FileSize := 0;
        end else begin
          //ファイルサイズ
          FItem.FileSize := SearchRec.FindData.nFileSizeLow;
        end;
        //最終更新日を記録
        FItem.FileDate := FileTimeToDateTime(SearchRec.FindData.ftLastWriteTime);
        //FItemをリストに追加
        FFileList.Add(FItem);
        Application.ProcessMessages;
      end;
    until FindNext(SearchRec) <> 0;

    FindClose(SearchRec);
  end;
end;

//=============================================================================
//  OnDataHint(OnDataよりも前に1回だけ発生)イベント処理
//  OnDataHintは表示分(StartIndex～EndIndex)に間に発生する
//  システムのイメージリストからファイルアイコンのイメージインデックスを取得
//  このイベントはListView1.OwnerData:=True;でないと機能しない
//=============================================================================
procedure TForm1.ListView1DataHint(Sender: TObject; StartIndex,
  EndIndex: Integer);
var
  FullPath   : String;
  SHFileInfo : TSHFileInfo;
  i : Integer;
begin
  if (StartIndex > FFileList.Count) or (EndIndex > FFileList.Count) then exit;

  for i := StartIndex to EndIndex do begin
    if FFileList[i].IconIndex < 0 then begin
      FullPath := BasePath+FFileList[i].FFileName;

      SHGetFileInfo(PChar(FullPath),
                          0,
                          SHFileInfo,
                          SizeOf(SHFileInfo),
                          SHGFI_SMALLICON or SHGFI_ICON or SHGFI_SYSICONINDEX);

      FFileList[i].IconIndex := SHFileInfo.iIcon;
    end;
  end;
end;

//=============================================================================
//  ListView1のOnDataイベント
//  ListViewの各Itemの描画が必要となった場合に発生
//  ListViewのItemとSubItemに値をセットする
//  このイベントはListView1.OwnerData:=True;でないと機能しない
//=============================================================================
procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
var
  FileSize  : Integer;
  ADateTime : TDateTime;
begin
  if Item.Index > FFileList.Count then exit;

  Item.Caption := FFileList.Items[Item.Index].FileName;

  FileSize := FFileList[Item.Index].FileSize;
  if FileSize = 0 then begin
    Item.SubItems.Add('');
  end else begin
    FileSize := (FileSize div 1024 ) + 1;
    Item.SubItems.Add(FormatFloat('###,##0 KB', FileSize));
  end;
  ADateTime := FFileList.Items[Item.Index].FileDate;
  Item.SubItems.Add(FormatDateTime('yyyy/mm/dd hh:nn', ADateTime));

  Item.ImageIndex := FFileList.Items[Item.Index].IconIndex;
end;

//=============================================================================
//  ソート
//  SortFileListは自前の関数でTListのコールバック関数
//=============================================================================
procedure TForm1.ListView1ColumnClick(Sender: TObject;
  Column: TListColumn);
begin
  if FFileList.Count > 0 then begin
    SortColumnIndex := Column.Index;
    //カラムをクリックする度にソート順を逆にする(トグル操作)
    SortColum[SortColumnIndex] := -SortColum[SortColumnIndex];
    FFileList.Sort(Addr(SortFFileList));
    //仮想リストビューなのでListViewの再描画を実行しないと反映しない
    ListView1.Refresh;
  end;
end;

//=============================================================================
//  TFileTime型の値をDelphiのTDateTime型に変換する関数
//=============================================================================
function TForm1.FileTimeToDateTime(ATime: TFileTime): TDateTime;
var
  SystemTime : TSystemTime;
  TempTime   : TFileTime;
begin
  try
    //FileTime形式(世界協定時刻)を地域にあわせる
    FileTimeToLocalFileTime(ATime, TempTime);
    //FileTime形式をSystemTime形式にする
    FileTimeToSystemTime(TempTime, SystemTime);
    //SystemTime形式をDelphiのTDateTime形式に変換
    Result:=SystemTimeToDateTime(SystemTime);
  except
    Result := 0;
  end;
end;

//=============================================================================
//  Windowsのシステムディレクトリのパスを取得(テスト用)
//  ファイルが多く存在するので表示速度のテストにいいかも知れない
//=============================================================================
function TForm1.GetWindowsSystemDir: String;
var
  Str : String;
  Len : Integer;
begin
  Len := GetSystemDirectory(nil, 0);
  SetLength(Str, Len);
  GetSystemDirectory(PChar(Str), Len);
  Result := IncludeTrailingPathDelimiter(Str);
end;

end.



04_リストビューのソート


上のサンプルで，カラムをクリックするソートの機能を実装しました．
そこで，ListView のソート部分だけのテストをしてみます．このサンプルには，トグル操作の機能は実装していません．また，リストビュー行の高さの設定に ImageList を用いています．


図8
設計時画面
  • 行の高さを調整するために TImageList を配置
  • TImageList の Height プロパティを 20
  • TImageList の Width プロパティを 1
  • TListView の StateImages プロパティに
    この ImageList1 を指定
図9
実行直後
図10
[値]の数値でソート

リスト4
リストビューのソート参考コード 
unit ListView04Unit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, Buttons, ImgList;

type
  TMyListView = class(TListView)
  private
  protected
  end;
  TForm1 = class(TForm)
    ListView1: TListView;
    ImageList1: TImageList;
    procedure FormShow(Sender: TObject);
    procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn);
    procedure ListView1Compare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
  private
    { Private 宣言 }
    function RandomNumber: String;
    function RandomAlphi: String;
  public
    { Public 宣言 }
    ColumnToSort : Integer;
  end;

var
  Form1: TForm1;

implementation

uses StrUtils, CommCtrl, Math;

{$R *.dfm}

//=============================================================================
//  テスト用にListView1に項目を作成
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  i     : Integer;
  AItem : TListItem;
begin
  ListView1.RowSelect := True;

  for i := 0 to 8 do begin
    AItem := ListView1.Items.Add;
    AItem.Caption := '項目' + IntToStr(i);
    AItem.SubItems.Add(RandomNumber);
    AItem.SubItems.Add(RandomAlphi);
  end;
end;

//=============================================================================
//  ListViewのカラムクリックでソートする
//  クリックされた列を記録するグローバル変数ColumnToSortを使用
//=============================================================================
procedure TForm1.ListView1ColumnClick(Sender: TObject;
  Column: TListColumn);
begin
  ColumnToSort := Column.Index;
  ListView1.AlphaSort;
end;

//=============================================================================
//  OnCompareイベント
//  クリックした列のソートを実行
//  ColumnToSortはクリックした列番号でグローバル変数
//  var Compareの符号を反対にすれば降順ソート
//=============================================================================
procedure TForm1.ListView1Compare(Sender: TObject; Item1, Item2: TListItem;
  Data: Integer; var Compare: Integer);
var
  Index : Integer;
  V1    : Integer;
  V2    : Integer;
begin
  if ColumnToSort = 0 then begin
    Compare := CompareText(Item1.Caption, Item2.Caption)
  end else begin
    //SubItemのIndexは0,1,2,...
    Index := ColumnToSort - 1;
    //数値に変換して比較
    if Index = 0 then begin
      V1 := StrToIntDef(Trim(Item1.SubItems[Index]), 0);
      V2 := StrToIntDef(Trim(Item2.SubItems[Index]), 0);
      Compare := Sign(V1 - V2);
    end else
    //文字列で比較
    if Index = 1 then begin
      Compare := CompareText(Item1.SubItems[Index], Item2.SubItems[Index]);
    end;
  end;
end;

//=============================================================================
//  テスト用に1～100までの乱数を発生．文字列で返す
//  備考
//  乱数発生の初期化はRandomizeか，RandSeedを使用する
//=============================================================================
function TForm1.RandomNumber: String;
begin
  Result:=Format('%d ', [Trunc(Random(100) + 1)]);
end;

//=============================================================================
//  テスト用にA～Zまでの3文字の文字列をランダムに発生
//  備考
//  乱数発生の初期化はRandomizeか，RandSeedを使用する
//  DupeStringはStrUtils.pasにある
//=============================================================================
function TForm1.RandomAlphi: String;
var
  Str : String;
begin
  Str := Chr(Random($5B - $41) + $41);
  Result := DupeString(Str, 3);
end;

end.



05_大きなアイコンを表示


これまでは，ファイルのアイコンとして小さなアイコンを表示していました．これを大きなアイコンとするサンプルです．システムイメージの取得のフラグにSHGFI_LARGEICONを指定しています．


図11
設計時画面
  • TImageListを使用しないコード
図12
実行画面

リスト5
リストビューに大きなアイコンを表示 
unit ListView05Unit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, Buttons;

type
  TForm1 = class(TForm)
    Panel2: TPanel;
    Panel1: TPanel;
    StatusBar1: TStatusBar;
    ListView1: TListView;
    btnExpandFolder: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure btnExpandFolderClick(Sender: TObject);
  private
    { Private 宣言 }
    ExpandFolder : String;
    procedure SetFilesListToItems(APath: String);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses FileCtrl, ShellAPI, CommCtrl;

{$R *.dfm}

//=============================================================================
//  フォーム作成時
//  システムのイメージリストをListViewに関連付ける
//  SHGetFileInfoの取得アイコンにSHGFI_SYSICONINDEXを付加するのがミソ
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  SHFileInfo    : TSHFileInfo;
  ImgListHandle : THandle;
begin
  //コモンコントロールのイニシャライズ
  InitCommonControls() ;
  //システムのイメージリストのハンドルを取得
  ImgListHandle := SHGetFileInfo('C:\',
                   0,
                   SHFileInfo,
                   SizeOf(SHFileInfo),
                   SHGFI_LARGEICON or SHGFI_SYSICONINDEX);

  ListView_SetImageList(ListView1.Handle, ImgListHandle, 1);
end;

//=============================================================================
//  [Folder]ボタン
//  表示フォルダ(ディレクトリ)の指定
//  SelectDirectoryの使用にはusesにFileCtrlが必要
//=============================================================================
procedure TForm1.btnExpandFolderClick(Sender: TObject);
begin
  StatusBar1.Panels[0].Text := '';

  if SelectDirectory('表示フォルダ指定', '', ExpandFolder) then begin
    ExpandFolder := IncludeTrailingPathDelimiter(ExpandFolder);
    SetFilesListToItems(ExpandFolder);
  end;
end;

//=============================================================================
//  APathで指定するフォルダ内のファイル名をListViewのItemにセット
//  引数のAPathにはデリミタ必要
//=============================================================================
procedure TForm1.SetFilesListToItems(APath: String);
var
  SearchRec  : TSearchRec;
  AddItem    : TListItem;
  SHFileInfo : TSHFileInfo;
begin
  ListView1.Items.BeginUpdate;
  ListView1.Items.Clear;

  if FindFirst(APath + '*.*', faAnyFile, SearchRec) = 0 then begin
    repeat
      if ((SearchRec.Name <> '..') and (SearchRec.Name <> '.')) then begin
        //ファイル名を設定
        AddItem := ListView1.Items.Add;
        AddItem.Caption := ' ' + SearchRec.Name;
        //イメージリストからアイコンを取得してImageIndexにセット
        SHGetFileInfo(PChar(APath + SearchRec.Name),
                      0,
                      SHFileInfo,SizeOf(SHFileInfo),
                      SHGFI_LARGEICON or SHGFI_SYSICONINDEX);

        AddItem.ImageIndex := SHFileInfo.iIcon;
        Application.ProcessMessages;
      end;
     until FindNext(SearchRec) <> 0;

    FindClose(SearchRec);
  end;

  ListView1.Items.EndUpdate;
  StatusBar1.Panels[0].Text := ' ' + IntToStr(ListView1.Items.Count);
end;

end.


上のコードでは，フォルダの選択に SelectDirectory を使用しています．
Delphi 2007 以降であれば，次のように，TFileOpenDialog の Options に fdoPickFolders を含めるとフォルダの選択が可能となります．ただし，Vista 以降でないと動作しません．


図13
TFileOpenDialog		 

procedure TForm1.btnExpandFolderClick(Sender: TObject);
var
  FileDlg : TFileOpenDialog;
begin
  StatusBar1.Panels[0].Text := '';

  FileDlg := TFileOpenDialog.Create(Self);
  try
    FileDlg.Options := [fdoPickFolders, fdoPathMustExist, fdoForceFileSystem];
    FileDlg.DefaultFolder := '';
    if FileDlg.Execute then begin
      Update;
      ExpandFolder := IncludeTrailingPathDelimiter(FileDlg.FileName);
      SetFilesListToItems(ExpandFolder);
    end;
  finally
    FreeAndNil(FileDlg);
  end;
end;



06_アイテムのデータ格納用クラス


下のリストは，このページの仮想リストビューのサンプルコードの定義部分です，
TplDataList クラスの部分は全て共通となっています．また，TplDataListItem のプロパティもほとんど同じとなっています．この部分を変更すれば，データをリストとして扱うことができます．
もちろん，TplDataListItem はクラスですから，このリストでは文字列と数値だけですが，TImage や他のオブジェクトもデータとして保持することが可能です (ただし，オブジェクト型は生成と破棄のコードが必要)．また，これらのデータを保存したり，読出して再利用する場合は，TList の派生クラスである TComponentList を使用すると便利です． 


type
  TplDataListItem=class;

  TplDataList=class(TList)
  protected
    function Get(Index: Integer): TplDataListItem;
    procedure Put(Index: Integer; Item: TplDataListItem);
  public
    destructor Destroy; override;
    procedure Clear; virtual;
    function Add(Item: TplDataListItem): Integer;
    function IndexOf(Item: TplDataListItem): Integer;
    function Remove(Item: TplDataListItem): Integer;
    property Items[Index: Integer]: TplDataListItem read Get write Put; default;
  end;

  TplDataListItem =class(TObject)
  private
    FFileName   : String;
    FFileSize   : Integer;
    FFileDate   : TDateTime;
    FIconIndex  : Integer;
    FFileAttrib : Integer;
  public
  published
    //特にpublishedなプロパティにしなくても利用できるが，将来の拡張のため
    property FileName   : String   read FFileName   write FFileName;
    property FileSize   : Integer   read FFileSize   write FFileSize;
    property FileDate   : TDateTime read FFileDate   write FFileDate;
    property IconIndex  : Integer   read FIconIndex  write FIconIndex;
    property FileAttrib : Integer   read FFileAttrib write FFileAttrib;
  end;



07_リストビューにチェックボックス


リストビューには CheckBoxes プロパティがあり，項目の左端にチェックボックスを表示することができます．これは，マウスでもスペースキーでも ON, OFF ができます．仮想リストビューにこのチェックボックスを表示する前に，標準のリストビューでの動作確認することにします．

単にリストにチェックボックスを必要とするのであれば，TCheckListBox という Delphi 標準のコンポーネントも利用できます．TCheckListBox のチェック状態は，State プロパティで取得できます．



図14
設計時画面
  • オブジェクト・インスペクタで CheckBoxes プロパティを True にしておく
図15
実行画面1
  • Windows 7 U64(SP1) + Delphi XE Pro で EXE 作成
  • Windows 7 U64(SP1) で実行した結果

リスト6
仮想リストビューでないリストビューでチェックボックス表示の確認 
unit CheckBoxes_NonVirtualUnit;

interface

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

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  ListViewのいくつかのプロパティを設定
//  ListViewのOwnerDataプロパティはFalse(デフォルト)
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  ACol : TListColumn;
begin
  //ListViewの設定
  ListView1.ViewStyle   := vsReport;
  ListView1.MultiSelect := True;
  ACol := ListView1.Columns.Add;
  ACol.Width   := 150;
  ACol.Caption := '名前';
end;

//=============================================================================
//  フォームを表示したらテスト用データを作成
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  i     : Integer;
  AItem : TListItem;
begin
  ListView1.Items.Clear;

  for i := 0 to 80 do begin
    AItem := ListView1.Items.Add;
    AItem.Caption := Format('Item%.3d', [i]);
    AItem.Checked := False;
  end;
end;

//=============================================================================
//  コードでチェックボックスのOn,Offを制御する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AIndex : Integer;
begin
  AIndex := 6;
  //チェック状態を反転
  ListView1.Items[AIndex].Checked := not ListView1.Items[AIndex].Checked;
end;

//=============================================================================
//  チェックしてあるアイテムを削除する
//  チェックしてあるアイテムの操作の例として
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  AItem : TListItem;
  i     : Integer;
begin
  for i := ListView1.Items.Count - 1 downto 0 do begin
    AItem := ListView1.Items[i];
    if AItem.Checked then AItem.Delete;
  end;
end;

end.




08_仮想リストビューにチェックボックス


仮想リストビューでは CheckBoxes プロパティを True にしてもチェックボックスを表示してくれません．自分で画像イメージを用意して，描画のためのコードも書く必要があります．またチェックボックスが表示できても，マウスクリックで表示を切換えるには，マウスイベントでこの処理コードを追加しなければ動作しません．
本サンプルでは，スペースキーで切換えるコードも追加してみました．

本サンプルではチェックボックスの画像を用意して描画していますが，DrawFrameControl 関数を使用する方法もあります．あるいは Themes ユニットの関数類を使用して，テーマに対応した描画をする方法もあります．



図16
設計時画面
  • TImageList を配置
  • リストビューの StatusImages プロパティとする
図17
イメージリスト
  • チェックありとなしの画像を用意
  • ここではビットマップ
  • このイメージをマウスクリックで切換表示する
図18
実行画面

リスト7
仮想リストビューにチェックボックスを表示 
unit CheckBoxesUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ImgList, StdCtrls, ExtCtrls;

type
  TplDataListItem = class;

  TplDataList = class(TList)
  protected
    function Get(Index: Integer): TplDataListItem;
    procedure Put(Index: Integer; Item: TplDataListItem);
  public
    destructor Destroy; override;
    procedure Clear; virtual;
    function Add(Item: TplDataListItem): Integer;
    function IndexOf(Item: TplDataListItem): Integer;
    function Remove(Item: TplDataListItem): Integer;
    property Items[Index: Integer]: TplDataListItem read Get write Put; default;
  end;

  //プロパティはCaptionとChecedのみとした
  TplDataListItem =class(TObject)
  private
    FCaption : String;
    FChecked : Boolean;
  public
    property Caption : String  read FCaption write FCaption;
    property Checked : Boolean read FChecked write FChecked;
  end;

  TDataListItem = class(TplDataListItem);

  TForm1 = class(TForm)
    ListView1: TListView;
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    ImageList1: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ListView1Data(Sender: TObject; Item: TListItem);
    procedure ListView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ListView1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    DataList  : TplDataList;
    procedure SetDataListToItems;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses CommCtrl;

{ TplDataList }

//=============================================================================
//  仮想リストビュー用のデータを格納するTplDataListの関数とメソッド類
//  TListのこれらの関数，メソッドの引数や戻値はPointerであるが，ここでは
//  TplDataListItemにキャストするために再定義している
//  ClearメソッドはTplDataListのオブジェクト破棄のコードを追加するため再定義
//=============================================================================
destructor TplDataList.Destroy;
var
  i : Integer;
begin
  for i := 0 to Count - 1 do begin
    Items[i].Free;
  end;
  inherited;
end;

//-----------------------------------------------------------------------------
procedure TplDataList.Clear;
var
  i : Integer;
begin
  for i := 0 to Count - 1 do begin
    Items[i].Free;
  end;
  inherited;
end;

//-----------------------------------------------------------------------------
procedure TplDataList.Put(Index: Integer; Item: TplDataListItem);
begin
  inherited Items[Index] := Item;
end;
//-----------------------------------------------------------------------------
function TplDataList.Get(Index: Integer): TplDataListItem;
begin
  Result := TplDataListItem(inherited Items[Index]);
end;

//-----------------------------------------------------------------------------
function TplDataList.Add(Item: TplDataListItem): Integer;
begin
  Result := inherited Add(Item);
end;

//-----------------------------------------------------------------------------
function TplDataList.IndexOf(Item: TplDataListItem): Integer;
begin
    Result := inherited IndexOf(Item);
end;

//-----------------------------------------------------------------------------
function TplDataList.Remove(Item: TplDataListItem): Integer;
begin
  Result := inherited Remove(Item);
end;

{$R *.dfm}

//=============================================================================
//  開始時にDataListを生成
//  ListViewのいくつかのプロパティを設定
//  ListViewのOwnerDataプロパティをTrueにしておく
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  ACol : TListColumn;
begin
  DataList := TplDataList.Create;

  //ListViewの設定
  ListView1.ViewStyle   := vsReport;
  ListView1.MultiSelect := True;
  ACol := ListView1.Columns.Add;
  ACol.Width   := 150;
  ACol.Caption := '名前';
end;

//=============================================================================
//  フォームを表示したらテスト用データを作成
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  ListView1.Items.Clear;
  SetDataListToItems;

  //ListViewにItems数を通知してListViewの表示を更新
  //OnDataHint,OnDataイベントが発生して必要なItemの描画が行われる
  ListView1.Items.Count := DataList.Count;
end;

//=============================================================================
//  終了時はDataListを解放
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(DataList);
end;

//=============================================================================
//  テスト用データの生成メソッド
//=============================================================================
procedure TForm1.SetDataListToItems;
var
  i     : Integer;
  FItem : TDataListItem;
begin
  for i := 0 to 80 do begin
    FItem := TDataListItem.Create;
    FItem.Caption := Format('Item%.3d', [i]);
    FItem.Checked := False;
    DataList.Add(FItem);
  end;
end;

//=============================================================================
//  ListView1のOnDataイベント
//  ListViewのItem.Captionの設定
//  このOnDataイベントで設定しないと無効.OnDataHintでは設定しても無効
//  チェックボックスも同様
//
//  [備考]ListViewのOnDataHintイベントはスクロールすれば発生する
//=============================================================================
procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
begin
  Item.Caption := DataList[Item.Index].Caption;

  //StateIconを設定
  //1,0はImageList1のアイテム番号(0はチェックなし画像)
  if DataList[Item.Index].Checked then begin
    Item.StateIndex := 1;
  end else begin
    Item.StateIndex := 0;
  end;
end;

//=============================================================================
//  チェックボックス上のマウスダウン(クリック)でチェックボックスのOn,Off切換
//  データリストのCheckedプロパティを変更
//  実際の描画はListViewのRefreshメソッドを実行することで行う
//=============================================================================
procedure TForm1.ListView1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  AItem     : TListItem;
  AHitTests : THitTests;
begin
  AItem := ListView1.GetItemAt(X, Y);
  if AItem = nil then exit;

  //マウス左ボタンの時のみ
  if Button = mbLeft then begin
    //座標(X,Y)がStateIcon(状態アイコンまたはビットマップ)上の場合のみ処理
    AHitTests := ListView1.GetHitTestInfoAt(X, Y);
    if htOnStateIcon in AHitTests then begin
      DataList[AItem.Index].Checked := not DataList[AItem.Index].Checked;
      //ListViewの表示更新(OnDataイベントが発生する)
      ListView1.Refresh;
    end;
  end;
end;

//=============================================================================
//  現在選択中のアイテムのチェックボックスのOn,Offを[Space]キーで切換える
//=============================================================================
procedure TForm1.ListView1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  AItem : TListItem;
begin
  if Key=VK_SPACE then begin
    if ListView1.Selected=nil then exit;

    AItem := ListView1.Selected;
    while AItem <> nil do begin
      DataList[AItem.Index].Checked := not DataList[AItem.Index].Checked;
      AItem := ListView1.GetNextItem(AItem, sdAll, [isSelected]);
    end;
    //ListViewの表示更新(OnDataイベントが発生する)
    ListView1.Refresh;
  end;
end;

//=============================================================================
//  コードでチェックボックスのOn,Offを制御する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AIndex : Integer;
begin
  AIndex := 6;
  //チェック状態を反転
  DataList[AIndex].Checked := not DataList[AIndex].Checked;
  //ListViewの表示更新(OnDataイベントが発生する)
  ListView1.Refresh;
end;

//=============================================================================
//  チェックしてあるアイテムを削除する
//  チェックしてあるアイテムの操作の例として
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  i : Integer;
begin
  for i := DataList.Count - 1 downto 0 do begin
    if DataList[i].Checked then DataList.Delete(i);
  end;

  ListView1.Items.Count := DataList.Count;
  //ListViewの表示更新(OnDataまたはOnDataHintイベントが発生する)
  ListView1.Refresh;
end;

end.




09_仮想リストビューにチェックボックス - カスタム描画


仮想リストビューも，AdvancedCustomDrawXXX や OnCustomDrawXXX イベントが使用できます．このイベントを用いてチェックボックス付きの仮想リストビューの選択中のアイテムの背景色を変えるテストプログラムです．
イベント内では背景色と同時に文字も描画しなけりばいけませんので，結構面倒です．


図19
設計時画面
  • TImageList を配置
  • リストビューの StatusImages プロパティとする
図20
イメージリスト
  • チェックありとなしの画像を用意
  • ここではビットマップ
  • このイメージをマウスクリックで切換表示する
図21
実行画面
  • Vista, 7 本来の選択色よりも見やすいのでは

リスト8
仮想リストビューにチェックボックスを表示し，カスタム描画コードも追加 
unit CheckBoxes_OwnerDrawUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ImgList, StdCtrls, ExtCtrls;

type
  TplDataListItem = class;

  TplDataList = class(TList)
  protected
    function Get(Index: Integer): TplDataListItem;
    procedure Put(Index: Integer; Item: TplDataListItem);
  public
    destructor Destroy; override;
    procedure Clear; virtual;
    function Add(Item: TplDataListItem): Integer;
    function IndexOf(Item: TplDataListItem): Integer;
    function Remove(Item: TplDataListItem): Integer;
    property Items[Index: Integer]: TplDataListItem read Get write Put; default;
  end;

  //プロパティはCaptionとChecedのみとした
  TplDataListItem = class(TObject)
  private
    FCaption : String;
    FChecked : Boolean;
  public
    property Caption : String  read FCaption write FCaption;
    property Checked : Boolean read FChecked write FChecked;
  end;

  TDataListItem = class(TplDataListItem);

  TForm1 = class(TForm)
    ListView1: TListView;
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    ImageList1: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ListView1Data(Sender: TObject; Item: TListItem);
    procedure Button1Click(Sender: TObject);
    procedure ListView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ListView1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Button2Click(Sender: TObject);
    procedure ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
      var DefaultDraw: Boolean);
    procedure ListView1Click(Sender: TObject);
  private
    { Private 宣言 }
    DataList  : TplDataList;
    procedure SetDataListToItems(APath: String);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses CommCtrl, GraphUtil;

{ TplDataList }

//=============================================================================
//  仮想リストビュー用のデータを格納するTplDataListの関数とメソッド類
//  TListのこれらの関数，メソッドの引数や戻値はPointerであるが，ここでは
//  TplDataListItemにキャストするために再定義している
//  ClearメソッドはTplDataListのオブジェクト破棄のコードを追加するため再定義
//=============================================================================
destructor TplDataList.Destroy;
var
  i : Integer;
begin
  for i := 0 to Count - 1 do begin
    Items[i].Free;
  end;
  inherited;
end;

//-----------------------------------------------------------------------------
procedure TplDataList.Clear;
var
  i : Integer;
begin
  for i := 0 to Count - 1 do begin
    Items[i].Free;
  end;
  inherited;
end;

//-----------------------------------------------------------------------------
procedure TplDataList.Put(Index: Integer; Item: TplDataListItem);
begin
  inherited Items[Index] := Item;
end;

//-----------------------------------------------------------------------------
function TplDataList.Get(Index: Integer): TplDataListItem;
begin
  Result := TplDataListItem(inherited Items[Index]);
end;
//-----------------------------------------------------------------------------
function TplDataList.Add(Item: TplDataListItem): Integer;
begin
  Result := inherited Add(Item);
end;

//-----------------------------------------------------------------------------
function TplDataList.IndexOf(Item: TplDataListItem): Integer;
begin
  Result := inherited IndexOf(Item);
end;

//-----------------------------------------------------------------------------
function TplDataList.Remove(Item: TplDataListItem): Integer;
begin
  Result := inherited Remove(Item);
end;


{$R *.dfm}

//=============================================================================
//  開始時にDataListを生成
//  ListViewのいくつかのプロパティを設定
//  ListViewのOwnerDataプロパティをTrueにしておく
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  ACol : TListColumn;
begin
  DataList := TplDataList.Create;

  //ListViewの設定
  ListView1.ViewStyle   := vsReport;
  ListView1.MultiSelect := True;
  ACol := ListView1.Columns.Add;
  ACol.Width   := 150;
  ACol.Caption := '名前';
end;

//=============================================================================
//  フォームを表示したらテスト用データを作成
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  ListView1.Items.Clear;
  SetDataListToItems('');

  //ListViewにItems数を通知してListViewの表示を更新
  //OnDataHint,OnDataイベントが発生して必要なItemの描画が行われる
  ListView1.Items.Count := DataList.Count;
end;

//=============================================================================
//  終了時はDataListを解放
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(DataList);
end;

//=============================================================================
//  テスト用データの生成メソッド
//=============================================================================
procedure TForm1.SetDataListToItems(APath: String);
var
  i     : Integer;
  FItem : TDataListItem;
begin
  for i := 0 to 80 do begin
    FItem := TDataListItem.Create;
    FItem.Caption := Format('Item%.3d', [i]);
    FItem.Checked := False;
    DataList.Add(FItem);
  end;
end;

//=============================================================================
//  ListView1のOnDataイベント
//  ListViewのItem.Captionの設定
//  このOnDataイベントで設定しないと無効.OnDataHintでは設定しても無効
//  チェックボックスも同様
//
//  [備考]ListViewのOnDataHintイベントはスクロールすれば発生する
//=============================================================================
procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
begin
  Item.Caption := DataList[Item.Index].Caption;

  //StateIconを設定
  //1,0はImageList1のアイテム番号(0はチェックなし画像)
  if DataList[Item.Index].Checked then begin
    Item.StateIndex := 1;
  end else begin
    Item.StateIndex := 0;
  end;
end;

//=============================================================================
//  チェックボックス上のマウスダウン(クリック)でチェックボックスのOn,Off切換
//  データリストのCheckedプロパティを変更
//  実際の描画はListViewのRefreshメソッドを実行することで行う
//=============================================================================
procedure TForm1.ListView1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  AItem : TListItem;
  AHitTests : THitTests;
begin
  AItem := ListView1.GetItemAt(X, Y);
  if AItem = nil then exit;

  //マウス左ボタンの時のみ
  if Button = mbLeft then begin
    //座標(X,Y)がStateIcon(状態アイコンまたはビットマップ)上の場合のみ処理
    AHitTests := ListView1.GetHitTestInfoAt(X, Y);
    if htOnStateIcon in AHitTests then begin
      DataList[AItem.Index].Checked := not DataList[AItem.Index].Checked;
      //ListViewの表示更新(OnDataイベントが発生する)
      ListView1.Refresh;
    end;
  end;
end;

//=============================================================================
//  現在選択中のアイテムのチェックボックスのOn,Offを[Space]キーで切換える
//=============================================================================
procedure TForm1.ListView1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  AItem : TListItem;
begin
  if Key = VK_SPACE then begin
    if ListView1.Selected = nil then exit;

    AItem := ListView1.Selected;
    while AItem <> nil do begin
      DataList[AItem.Index].Checked := not DataList[AItem.Index].Checked;
      AItem := ListView1.GetNextItem(AItem, sdAll, [isSelected]);
    end;
    //ListViewの表示更新(OnDataイベントが発生する)
    ListView1.Refresh;
  end;
end;

//=============================================================================
//  コードでチェックボックスのOn,Offを制御する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AIndex : Integer;
begin
  AIndex := 6;
  //チェック状態を反転
  DataList[AIndex].Checked := not DataList[AIndex].Checked;
  //ListViewの表示更新(OnDataイベントが発生する)
  ListView1.Refresh;
end;

//=============================================================================
//  チェックしてあるアイテムを削除する
//  チェックしてあるアイテムの操作の例として
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  i : Integer;
begin
  for i := DataList.Count - 1 downto 0 do begin
    if DataList[i].Checked then DataList.Delete(i);
  end;
  ListView1.Items.Count := DataList.Count;
  //ListViewの表示更新(OnDataまたはOnDataHintイベントが発生する)
  ListView1.Refresh;
end;

//=============================================================================
//  ListView1のItemのカスタムDrawの例 最初の列のみ
//  仮想リストビューでもOnCustom...イベントの使用は可能
//  OnDrawItemは使用不可
//
//  Delphi2007であればGraphUtil.pasにGradientFillCanvasという関数があり，グラ
//  デーションも描画可能
//=============================================================================
procedure TForm1.ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
  var DefaultDraw: Boolean);
var
  ARect   : TRect;
  ABitmap : TBitmap;
begin
  //描画前
  if Stage = cdPrePaint then begin
    //選択中のItemに対してのみカスタム描画
    if cdsSelected in State then begin
      ABitmap := TBitmap.Create;
      try
        //チェックボックスのビットマップをImageList1から取得
        if DataList[Item.Index].Checked then begin
          ImageList1.GetBitmap(1, ABitmap);
        end else begin
          ImageList1.GetBitmap(0, ABitmap);
        end;

        ARect := Item.DisplayRect(drLabel);

        //Delphi2007以上
        {$IF CompilerVersion > 18.49}
        ARect.Right := ARect.Right - 2;
        GradientFillCanvas(ListView1.Canvas,
                           $00FFE7CE,
                           $00FFCA95,
                           ARect,
                           gdVertical);
        {$ELSE}
        ListView1.Canvas.Brush.Color := clSilver;
        ListView1.Canvas.FillRect(ARect);
        {$IFEND}
        SetBkMode(ListView1.Canvas.Handle, TRANSPARENT);

        ARect := Item.DisplayRect(drLabel);
        ARect.Left := ARect.Left + 2;
        DrawText(ListView1.Canvas.Handle,
                 PChar(Item.Caption),
                 -1,
                 ARect,
                 DT_LEFT or DT_SINGLELINE or DT_VCENTER);

        //チェックボックスを描画
        //+4は描画するビットマップによって調整する
        ARect := Item.DisplayRect(drBounds);
        ListView1.Canvas.Draw(ARect.Left + 4, ARect.Top, ABitmap);
      finally
        FreeAndNil(ABitmap);
      end;
      //デフォルトの描画は実行しない
      DefaultDraw := False;
    end;
  end;
end;

//=============================================================================
//  選択項目がある場合，項目以外の場所をクリック(選択解除)するとキャプションの
//  文字以外が選択中の背景色のままになってしまう現象の回避策
//  これはRowSelect:=Falseの場合に発生する
//=============================================================================
procedure TForm1.ListView1Click(Sender: TObject);
begin
  ListView1.Refresh;
end;

end.




10_ファイル一覧・仮想リストビューにチェックボックス


これまでのテストを参考にして，[03 ファイル一覧・仮想リストビュー(システムのイメージリストを使用)] のサンプルにチェックボックスを表示し，カスタム描画のコードを追加してみました．

当サイトの他のサンプルプログラムもそうですか，このような仕様のものが実務で必要であるかどうかは別の問題です．ある掲示板で質問があったので，あくまでもテストプログラムとして作成したものです．チェックボックスの選択とファイル名の選択とはどう使い分けるのでしょうか．



図22
設計時画面
  • TImageList を配置
図23
イメージリスト
  • チェックありとなしの画像を用意
  • ここではビットマップ
  • このイメージをマウスクリックで切換表示する
図24
実行画面1
  • Delphi 2007 以降の機能を使用して選択中の背景色をグラデーションにしてみた

リスト9
仮想リストビューでファイル一覧サンプルにチェックボックス
カスタム描画 (オーナードロー) のコードも追加 
unit CheckBoxes_FilesListUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, ImgList;

type
  TplDataListItem = class;

  TplDataList = class(TList)
  protected
    function Get(Index: Integer): TplDataListItem;
    procedure Put(Index: Integer; Item: TplDataListItem);
  public
    destructor Destroy; override;
    procedure Clear; virtual;
    function Add(Item: TplDataListItem): Integer;
    function IndexOf(Item: TplDataListItem): Integer;
    function Remove(Item: TplDataListItem): Integer;
    property Items[Index: Integer]: TplDataListItem read Get write Put; default;
  end;

  TplDataListItem = class(TObject)
  private
    FFileName   : String;
    FFileSize   : Integer;
    FFileDate   : TDateTime;
    FIconIndex  : Integer;
    FFileAttrib : Integer;
    FChecked    : Boolean;
  published
    //特にpublishedなプロパティにしなくても利用できるが，将来の拡張のため
    property FileName   : String    read FFileName   write FFileName;
    property FileSize   : Integer   read FFileSize   write FFileSize;
    property FileDate   : TDateTime read FFileDate   write FFileDate;
    property IconIndex  : Integer   read FIconIndex  write FIconIndex;
    property FileAttrib : Integer   read FFileAttrib write FFileAttrib;
    property Checked    : Boolean   read FChecked    write FChecked;
  end;

  TFileListItem = class(TplDataListItem);

  TForm1 = class(TForm)
    Panel2: TPanel;
    Panel3: TPanel;
    Button1: TButton;
    Panel1: TPanel;
    ListView1: TListView;
    ImageList1: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ListView1Data(Sender: TObject; Item: TListItem);
    procedure ListView1DataHint(Sender: TObject; StartIndex,
      EndIndex: Integer);
    procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn);
    procedure ListView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ListView1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
      var DefaultDraw: Boolean);
  private
    { Private 宣言 }
    BasePath      : String;
    FFileList     : TplDataList;
    ImgListHandle : THandle;
    procedure SetFilesListToItems(APath: String);
    function FileTimeToDateTime(ATime:TFileTime): TDateTime;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses FileCtrl, ShellAPI, ShlObj, CommCtrl, Math, DateUtils, GraphUtil, Types;

{$R *.dfm}

var
  //ソート関係の変数
  //SortColumnIndexはソートするカラム番号ごとにソート順を保持
  //SortColumnIndexはソートするカラムのインデックス
  SortColum       : array[0..2] of integer;
  SortColumnIndex : Integer;

{ TplDataList }

//=============================================================================
//  ファイル情報を格納するTplDataListの関数とメソッド類
//  TListのこれらの関数，メソッドの引数や戻値はPointerであるが，ここでは
//  TplDataListItemにキャストするために再定義　　
//  ClearメソッドはTplDataListのオブジェクト破棄のコードを追加するため再定義
//=============================================================================
destructor TplDataList.Destroy;
var
  i : Integer;
begin
  for i := 0 to Count - 1 do begin
    Items[i].Free;
  end;
  inherited;
end;

//-----------------------------------------------------------------------------
procedure TplDataList.Clear;
var
  i : Integer;
begin
  for i := 0 to Count - 1 do begin
    Items[i].Free;
  end;
  inherited;
end;

//-----------------------------------------------------------------------------
procedure TplDataList.Put(Index: Integer; Item: TplDataListItem);
begin
  inherited Items[Index] := Item;
end;
//-----------------------------------------------------------------------------
function TplDataList.Get(Index: Integer): TplDataListItem;
begin
  Result := TplDataListItem(inherited Items[Index]);
end;

//-----------------------------------------------------------------------------
function TplDataList.Add(Item: TplDataListItem): Integer;
begin
  Result := inherited Add(Item);
end;

//-----------------------------------------------------------------------------
function TplDataList.IndexOf(Item: TplDataListItem): Integer;
begin
  Result := inherited IndexOf(Item);
end;

//-----------------------------------------------------------------------------
function TplDataList.Remove(Item: TplDataListItem): Integer;
begin
  Result := inherited Remove(Item);
end;


//=============================================================================
//  FFileList(TList)用のソートのコールバック関数
//  Item1>Item2の時<0 Item10 Item1=Item2の時0を返すと昇順
//  オブジェクトを持たないTListの昇順ソートはSortメソッドを実行すればよい
//  降順やオブジェクトでソートする場合はコールバック関数を使用する必要がある
//=============================================================================
function SortFFileList(Item1, Item2: Pointer): Integer;
var
  Index1 : Integer;
  Index2 : Integer;
  Int1   : Int64;
  Int2   : Int64;
  Str1   : String;
  Str2   : String;
  Date1  : TDateTime;
  Date2  : TDateTime;
  Dir1   : Boolean;
  Dir2   : Boolean;
begin
  Index1 := Form1.FFileList.IndexOf(Item1);
  Index2 := Form1.FFileList.IndexOf(Item2);

  Result := 0;
  case SortColumnIndex of
  //名前
  0:
    begin
      Dir1 := (Form1.FFileList[Index1].FileAttrib and faDirectory) <> 0;
      Dir2 := (Form1.FFileList[Index2].FileAttrib and faDirectory) <> 0;

      Str1 := Form1.FFileList[Index1].FileName;
      Str2 := Form1.FFileList[Index2].FileName;

      //どちらもフォルダかどちらもフォルダでない場合
      if (Dir1 and Dir2) or not(Dir1 or Dir2) then begin
        Result := SortColum[SortColumnIndex] * CompareStr(Str1, Str2);
      end else
      //Item1に該当するのがフォルダの場合
      if Dir1 then begin
        Result := -SortColum[SortColumnIndex];
      end else
      //Item2に該当するのがフォルダの場合
      if Dir2 then begin
        Result := SortColum[SortColumnIndex];
      end;
    end;
  //サイズ
  1:
    begin
      Int1 := Form1.FFileList[Index1].FFileSize;
      Int2 := Form1.FFileList[Index2].FFileSize;
      Result := SortColum[SortColumnIndex] * CompareValue(Int1, Int2);
    end;
  //更新日時
  2:
    begin
      Dir1  := (Form1.FFileList[Index1].FileAttrib and faDirectory) <> 0;
      Dir2  := (Form1.FFileList[Index2].FileAttrib and faDirectory) <> 0;

      Date1 := Form1.FFileList[Index1].FileDate;
      Date2 := Form1.FFileList[Index2].FileDate;

      //どちらもフォルダかどちらもフォルダでない場合
      if (Dir1 and Dir2) or not(Dir1 or Dir2) then begin
        Result := SortColum[SortColumnIndex] * CompareDate(Date1, Date2);
      end else
      //Item1に該当するのがフォルダの場合
      if Dir1 then begin
        Result := -SortColum[SortColumnIndex];
      end else
      //Item2に該当するのがフォルダの場合
      if Dir2 then begin
        Result := SortColum[SortColumnIndex];
      end;
    end;
  end;
end;

//=============================================================================
//  フォーム作成時
//  (1)ファイルリスト格納用のFFileListの生成
//  (2)システムのイメージリストをListViewに関連付ける
//     SHGetFileInfoの取得アイコンにSHGFI_SYSICONINDEXを付加するのがミソ
//
//  仮想リストビューではスクロールの度に再描画が行われるのでチラツクことがある
//  そこでListView1.DoubleBuffered:=True;としている
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  SHFileInfo    : TSHFileInfo ;
  i             : Integer;
begin
  ListView1.DoubleBuffered := True;
  FFileList := TplDataList.Create;

  //コモンコントロールのイニシャライズ
  InitCommonControls() ;
  //システムのイメージリストのハンドルを取得
  ImgListHandle := SHGetFileInfo('',
                   0,
                   SHFileInfo,
                   SizeOf(SHFileInfo),
                   SHGFI_ICON or SHGFI_SMALLICON or SHGFI_SYSICONINDEX);

  ListView_SetImageList(ListView1.Handle, ImgListHandle, LVSIL_SMALL);

  //ソートで使用する配列値に代入
  //ソート対象カラムの初期値は0(名前のカラム)
  SortColumnIndex := 0;
  for i := 0 to Length(SortColum) - 1 do begin
    SortColum[i] := 1;
  end;
end;

//=============================================================================
//  使い終わったら解放
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FFileList);
end;

//=============================================================================
//  検索開始
//  SelectDirectoryの使用にはusesにFileCtrlが必要
//
//  SetFilesListToItemsの引数にはGUID文字列は使用できない
//  GUIDで表されるフォルダは不可であるが，具体的なフォルダ名のものは，例えば
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Panel1.Caption := '';

  if SelectDirectory('検索フォルダ指定', '', BasePath, []) then begin
    BasePath := IncludeTrailingPathDelimiter(BasePath);
    Update;
    //ListViewのItemsをクリアしてからFFileList.Clear
    ListView1.Items.Clear;
    FFileList.Clear;
    SetFilesListToItems(BasePath);

    ListView1.Items.Count := FFileList.Count;
    //ソート
    if FFileList.Count > 0 then begin
      FFileList.Sort(Addr(SortFFileList));
    end;
  end;
  Panel1.Caption := '該当ファイル数 : ' + IntToStr(FFileList.Count);
end;

//=============================================================================
//  APathで指定するフォルダ内のファイルの情報をFFileListの各Itemに格納
//  アイコンはOnDataHintイベント内で表示分だけ取得する
//=============================================================================
procedure TForm1.SetFilesListToItems(APath: String);
var
  SearchRec : TSearchRec;
  FItem     : TFileListItem;
  Attrib    : Integer;
begin
  if FindFirst(APath + '*.*', faAnyFile, SearchRec) = 0 then begin
    repeat
      if ((SearchRec.Name <> '..') and (SearchRec.Name <> '.')) then begin
        FItem := TFileListItem.Create;
        FItem.IconIndex := -1;
        //属性を取得
        Attrib := SearchRec.Attr;
        //ファイル名を記録
        FItem.FileName := SearchRec.Name;
        //ファイル属性を記録
        FItem.FileAttrib := Attrib;
        if BOOL( Attrib and faDirectory) then begin
          FItem.FileSize := 0;
        end else begin
          //ファイルサイズ
          FItem.FileSize := SearchRec.FindData.nFileSizeLow;
        end;
        //最終更新日を記録
        FItem.FileDate := FileTimeToDateTime(SearchRec.FindData.ftLastWriteTime);
        //FItemをリストに追加
        FFileList.Add(FItem);
        Application.ProcessMessages;
      end;
    until FindNext(SearchRec) <> 0;

    FindClose(SearchRec);
  end;
end;

//=============================================================================
//  OnDataHint(OnDataよりも前に1回だけ発生)イベント処理
//  OnDataHintは表示分(StartIndex～EndIndex)に間に発生する
//  システムのイメージリストからファイルアイコンのイメージインデックスを取得
//  このイベントはListView1.OwnerData:=True;でないと機能しない
//=============================================================================
procedure TForm1.ListView1DataHint(Sender: TObject; StartIndex,
  EndIndex: Integer);
var
  FullPath   : String;
  SHFileInfo : TSHFileInfo;
  i          : Integer;
begin
  if (StartIndex > FFileList.Count) or (EndIndex > FFileList.Count) then exit;

  for i := StartIndex to EndIndex do begin
    if FFileList[i].IconIndex < 0 then begin
      FullPath := BasePath+FFileList[i].FFileName;
      SHGetFileInfo(PChar(FullPath),
                          0,
                          SHFileInfo,
                          SizeOf(SHFileInfo),
                          SHGFI_SMALLICON or SHGFI_ICON or SHGFI_SYSICONINDEX);

      FFileList[i].IconIndex := SHFileInfo.iIcon;
    end;
  end;
end;

//=============================================================================
//  ListView1のOnDataイベント
//  ListViewの各Itemの描画が必要となった場合に発生
//  ListViewのItemとSubItemに値をセットする
//  このイベントはListView1.OwnerData:=True;でないと機能しない
//=============================================================================
procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
var
  FileSize  : Integer;
  ADateTime : TDateTime;
begin
  if Item.Index > FFileList.Count then exit;

  Item.Caption := FFileList.Items[Item.Index].FileName;
  FileSize     := FFileList[Item.Index].FileSize;

  if FileSize = 0 then begin
    Item.SubItems.Add('');
  end else begin
    FileSize := (FileSize div 1024 ) + 1;
    Item.SubItems.Add(FormatFloat('###,##0 KB', FileSize));
  end;
  ADateTime := FFileList.Items[Item.Index].FileDate;
  Item.SubItems.Add(FormatDateTime('yyyy/mm/dd hh:nn', ADateTime));

  Item.ImageIndex := FFileList.Items[Item.Index].IconIndex;

  //StateIconを設定
  //1,0はImageList1のアイテム番号(0はチェックなし画像)
  if FFileList[Item.Index].Checked then begin
    Item.StateIndex := 1;
  end else begin
    Item.StateIndex := 0;
  end;
end;

//=============================================================================
//  ソート
//  SortFileListは自前の関数でTListのコールバック関数
//=============================================================================
procedure TForm1.ListView1ColumnClick(Sender: TObject;
  Column: TListColumn);
begin
  if FFileList.Count > 0 then begin
    SortColumnIndex := Column.Index;
    //カラムをクリックする度にソート順を逆にする(トグル操作)
    SortColum[SortColumnIndex] := -SortColum[SortColumnIndex];
    FFileList.Sort(Addr(SortFFileList));
    //仮想リストビューなのでListViewの再描画を実行しないと反映しない
    ListView1.Refresh;
  end;
end;

//=============================================================================
//  TFileTime型の値をDelphiのTDateTime型に変換する関数
//=============================================================================
function TForm1.FileTimeToDateTime(ATime: TFileTime): TDateTime;
var
  SystemTime : TSystemTime;
  TempTime   : TFileTime;
begin
  try
    //FileTime形式(世界協定時刻)を地域にあわせる
    FileTimeToLocalFileTime(ATime, TempTime);
    //FileTime形式をSystemTime形式にする
    FileTimeToSystemTime(TempTime, SystemTime);
    //SystemTime形式をDelphiのTDateTime形式に変換
    Result:=SystemTimeToDateTime(SystemTime);
  except
    Result:=0;
  end;
end;

//=============================================================================
//  チェックボックス上のマウスダウン(クリック)でチェックボックスのOn,Off切換
//  データリストのCheckedプロパティを変更
//  実際の描画はListViewのRefreshメソッドを実行することで行う
//  更新に必要な内容に応じてOnDataHint,OnDataイベントが発生する
//=============================================================================
procedure TForm1.ListView1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  AItem : TListItem;
  AHitTests : THitTests;
begin
  AItem := ListView1.GetItemAt(X,Y);
  if AItem = nil then exit;

  //マウス左ボタンの時のみ
  if Button=mbLeft then begin
    //座標(X,Y)がStateIcon(状態アイコンまたはビットマップ)上の場合のみ処理
    AHitTests := ListView1.GetHitTestInfoAt(X, Y);
    if htOnStateIcon in AHitTests then begin
      FFileList[AItem.Index].Checked := not FFileList[AItem.Index].Checked;
      //ListViewの表示更新(OnDataイベントが発生する)
      ListView1.Refresh;
    end;
  end;
end;

//=============================================================================
//  現在選択中のアイテムのチェックボックスのOn,Offを[Space]キーで切換える
//=============================================================================
procedure TForm1.ListView1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  AItem : TListItem;
begin
  if Key=VK_SPACE then begin
    if ListView1.Selected = nil then exit;

    AItem := ListView1.Selected;
    while AItem<>nil do begin
      FFileList[AItem.Index].Checked := not FFileList[AItem.Index].Checked;
      AItem := ListView1.GetNextItem(AItem,sdAll, [isSelected]);
    end;
    //ListViewの表示更新(OnDataイベントが発生する)
    ListView1.Refresh;
  end;
end;

//=============================================================================
//  ListView1のItemのカスタムDrawの例
//  キャプションだけではなくチェックボックスも描画しなければならない
//  仮想リストビューでもOnCustom...イベントの使用は可能
//  OnDrawItemは使用不可
//
//  Delphi2007であればGraphUtil.pasにGradientFillCanvasという関数があり，グラ
//  デーションも描画可能
//=============================================================================
procedure TForm1.ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
  var DefaultDraw: Boolean);
var
  ARect       : TRect;
  ALRect      : TRect;
  StateBitmap : TBitmap;
  AIcon       : TIcon;
begin
  //描画前
  if Stage = cdPrePaint then begin
    //選択中のItemに対してのみカスタム描画
    if (cdsSelected in State) then begin
      StateBitmap := TBitmap.Create;
      AIcon       := TIcon.Create;
      try
        //チェックボックスのビットマップをImageList1から取得
        if FFileList[Item.Index].Checked then begin
          ImageList1.GetBitmap(1,StateBitmap);
        end else begin
          ImageList1.GetBitmap(0,StateBitmap);
        end;
        //イメージリストからファイルのアイコンを取出す
        AIcon.Handle := ImageList_GetIcon(ImgListHandle,
                                          FFileList[Item.Index].IconIndex,
                                          ILD_NORMAL);

        //Captionの背景色と文字列を描画
        //背景色をどの範囲にするかで設定する
        ARect  := Item.DisplayRect(drSelectBounds);
        if ListView1.RowSelect then begin
          ALRect := Item.DisplayRect(drIcon);
          ARect.Left := ARect.Left+ALRect.Right;
        end;

        //Delphi2007以上
        {$IF CompilerVersion > 18.49}
        ARect.Right := ARect.Right - 2;
        GradientFillCanvas(ListView1.Canvas,
                           $00FFE7CE,
                           $00FFCA95,
                           ARect,
                           gdVertical);
        {$ELSE}
        ListView1.Canvas.Brush.Color := clSilver;
        ListView1.Canvas.FillRect(ARect);
        {$IFEND}
        SetBkMode(ListView1.Canvas.Handle, TRANSPARENT);

        ARect := Item.DisplayRect(drLabel);
        ARect.Left := ARect.Left + 2;
        DrawText(ListView1.Canvas.Handle,
                 PChar(Item.Caption),
                 -1,
                 ARect,
                 DT_LEFT or DT_SINGLELINE or DT_VCENTER);

        //チェックボックスを描画
        //+4は描画するビットマップによって調整する
        ARect := Item.DisplayRect(drBounds);
        ListView1.Canvas.Draw(ARect.Left + 4, ARect.Top, StateBitmap);

        //ファイルのアイコンを描画
        ARect := Item.DisplayRect(drIcon);
        ListView1.Canvas.Draw(ARect.Left, ARect.Top, AIcon);

        //サブアイテムの描画
        //ファイルサイズの文字列
        ListView_GetSubItemRect(ListView1.Handle,
                                Item.Index,
                                1,
                                LVIR_BOUNDS,
                                @ARect);

        ARect.Right := ARect.Right - 6;
        DrawText(ListView1.Canvas.Handle,
                 PChar(Item.SubItems[0]),
                 -1,
                 ARect,
                 DT_RIGHT or DT_SINGLELINE or DT_VCENTER);

        //更新日時の文字列
        ListView_GetSubItemRect(ListView1.Handle,
                                Item.Index,
                                2,
                                LVIR_BOUNDS,
                                @ARect);

        ARect.Left := ARect.Left + 6;
        DrawText(ListView1.Canvas.Handle,
                 PChar(Item.SubItems[1]),
                 -1,
                 ARect,
                 DT_LEFT or DT_SINGLELINE or DT_VCENTER);
      finally
        FreeAndNil(StateBitmap);
        FreeAndNil(AIcon);
      end;
      //デフォルトの描画は実行しない
      DefaultDraw := False;
    end;
  end;
end;

end.