[ 800_フォルダの一覧表示 ]

Delphi Programming / Object Pascal

[掲載 2007年04月26日] [更新 2019年06月27日]　Delphi サンプルプログラム集

800_フォルダの一覧表示
動作確認等	Windows 7 U64(SP1) + Delphi XE(UP1) Pro 一部 Delphi XE2 以降専用サンプルあり

800_FolderTree.zip　[4,885 KB]　2019年06月27日版 (EXE 同梱)

フォルダの一覧表示
01_フォルダの一覧表示 - フォルダだけをツリー表示
02_フォルダの一覧表示 - ファイルも表示
03_フォルダの一覧表示 - フォルダ・ファイル順に表示
04_フォルダの一覧表示 - 指定フォルダを選択状態にする
05_エクスプローラからのドラッグ・アンド・ドロップ
06_TTreeView の展開折りたたみボタンを [+] [-] の画像にする
07_TTreeView の展開折りたたみボタンを矢印 ( 三角形 ) にする
08_VCL Style 使用時の TTreeView の展開折りたたみボタン

フォルダの一覧表示

TTreeView コンポーネントを使用したフォルダの一覧表示のサンプルです．
一覧取得の速度はキャッシュの状態も影響します，もしエクスプローラであらかじめこのプログラムで展開したいフォルダを展開しておけば，速くなりますが，キャッシュされていないフォルダの展開は遅くなります (この反対も同じ現象です)．

01_フォルダの一覧表示 - フォルダだけをツリー表示

ルートフォルダを指定して，そのフォルダの階層下のフォルダツリー表示します．
ルートフォルダより上の階層は表示しません．また，ルートフォルダそのものは表示しないようにしたサンプルです．

	図1 設計時画面ルートフォルダを指定する Button このルートフォルダ以下をツリー表示するフォルダを表示する TTreeView のみ配置
	図2 実行結果例 Button1 でルートフォルダを選択添付の [AAA] フォルダを選択した結果ルートフォルダである [AAA] は表示しない

リスト1
指定フォルダ内のフォルダツリー表示
ルートノードを表示しないコード

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Button1: TButton;
    TreeView1: TTreeView;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
    procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
  private
    { Private 宣言 }
    FRootFolder : String;
    FRootNode   : TTreeNode;
    procedure SetFolderListToTreeView(APath: String; Node: TTreeNode; 
      Flag: Boolean);
    function GetFullPathFromNode(Node: TTreeNode): String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses 
  FileCtrl, 
  ShellAPI, 
  CommCtrl;

{$R *.dfm}

//=============================================================================
//  各ノードのアイコンにTImageListを使わずに，システムのイメージリストを取得し
//  てTreeView1のイメージリストに割当てる
//  usseにShellAPI,CommCtrlが必要
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LSHFileInfo    : TSHFileInfo;
  LImgListHandle : THandle;
begin
  //コモンコントロールのイニシャライズ
  InitCommonControls;
  //システムのイメージリストのハンドルを取得
  LImgListHandle := SHGetFileInfo(
    '',
    0,
    LSHFileInfo,
    SizeOf(LSHFileInfo),
    SHGFI_ICON or SHGFI_SMALLICON or SHGFI_OPENICON or SHGFI_SYSICONINDEX);

  TreeView_SetImageList(TreeView1.Handle, LImgListHandle, TVSIL_NORMAL);
  TreeView1.Items.Clear;

  //テスト用にこのプロジェクトのフォルダをルートとして選択可能にしておく
  FRootFolder := ExtractFilePath(Application.ExeName) + 'AAA';
end;

//=============================================================================
//  検索開始
//  FRootFolder(グローバル変数)は検索開始フォルダ名(ルートフォルダ)
//
//  SelectDirectoryの使用にはusesにFileCtrlが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  TreeView1.Items.BeginUpdate;

  if SelectDirectory('検索フォルダ指定', '', FRootFolder, []) then begin
    Screen.Cursor := crHourGlass;
    TreeView1.Items.Clear;

    FRootFolder := IncludeTrailingPathDelimiter(FRootFolder);
    FRootNode := nil;
    SetFolderListToTreeView(FRootFolder, FRootNode, True);
    Screen.Cursor := crDefault;
  end;

  TreeView1.Items.EndUpdate;
end;

//=============================================================================
//  TTreeViewのOnExpandingイベント処理
//  ノードが展開しようとした時
//  [+]ボタンが表示されていても実際に下位フォルダを取得していない時は取得
//  引数のNodeは，これから展開するノード
//=============================================================================
procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
  var AllowExpansion: Boolean);
var
  LFullPath : String;
begin
  if Node.HasChildren then begin
    if Node.Count = 0 then begin
      Screen.Cursor := crHourGlass;

      TTreeView(Sender).Items.BeginUpdate;
      LFullPath := GetFullPathFromNode(Node);
      SetFolderListToTreeView(LFullPath, Node, True);
      TTreeView(Sender).Items.EndUpdate;

      Screen.Cursor := crDefault;
    end;
  end;
end;

//=============================================================================
//  TTreeViewのOnChangeイベント処理
//  選択ノードが変更になった時
//  SelectedIndexにSHGFI_OPENICONを代入(Vista以降では意味なし)
//=============================================================================
procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
var
  LSelectNode : TTreeNode;
  LFullPath   : String;
  LSHFileInfo : TSHFileInfo;
begin
  LSelectNode := TreeView1.Selected;
  if LSelectNode = nil then exit;

  LFullPath := GetFullPathFromNode(LSelectNode);
  SHGetFileInfo(
    PChar(LFullPath),
    0,
    LSHFileInfo,
    SizeOf(LSHFileInfo),
    SHGFI_SMALLICON or SHGFI_OPENICON or SHGFI_ICON or SHGFI_SYSICONINDEX);

  LSelectNode.SelectedIndex := LSHFileInfo.iIcon;
end;

//-----------------------------------------------------------------------------
//  フォルダの検索ルーチン
//  特殊フォルダの展開はできないの注意
//  1つ下の階層まで検索するが，1つ下の階層のフォルダはノードに追加はしない
//  フォルダが存在する印[+]をノードに追加するだけとする(高速にするため)
//  実際のノードの追加は，OnExpandingイベント内で実行する
//
//  APath : 検索フォルダ名．最後尾にデリミタが必要
//  Node  : 検索フォルダに該当するTreeViewのノード
//  Flag  : True  フォルダ内を全て検索
//          False フォルダ1つでも見つかったら検索終了
//-----------------------------------------------------------------------------
procedure TForm1.SetFolderListToTreeView(APath: String; Node: TTreeNode;
  Flag: Boolean);
var
  LSearchPath : String;
  LSHFileInfo : TSHFileInfo;
  LAddNode    : TTreeNode;
  LFindHandle : THandle;
  LFileName   : String;
  LAttrib     : DWORD;
  LFileData   : TWin32FindData;
begin
  LFindHandle := FindFirstFile(PChar(APath + '*.*'), LFileData);

  if LFindHandle <> INVALID_HANDLE_VALUE then begin
    repeat
      LFileName := LFileData.cFileName;
      LAttrib   := LFileData.dwFileAttributes;

      if not ((LFileName = '..') or (LFileName = '.')) then begin
        if BOOL(LAttrib and FILE_ATTRIBUTE_DIRECTORY) then begin
          LSearchPath := IncludeTrailingPathDelimiter(APath) + LFileName;

          //下の階層は一回だけサーチ
          if Flag = False then begin
            //下の階層にもフォルダがあれば[+]ボタンを表示
            if Node <> nil then Node.HasChildren := True;
            break;
          end else begin
            LAddNode:=TreeView1.Items.AddChild(node,LFileName);
            SHGetFileInfo(PChar(LSearchPath),
                          0,
                          LSHFileInfo,
                          SizeOf(LSHFileInfo),
                          SHGFI_SMALLICON or SHGFI_ICON or SHGFI_SYSICONINDEX);

            LAddNode.ImageIndex := LSHFileInfo.iIcon;
            LSearchPath := IncludeTrailingPathDelimiter(LSearchPath);

            //この下位のフォルダを再帰検索
            SetFolderListToTreeView(LSearchPath, LAddNode,False);
          end;
        end;
      end;
    until FindNextFile(LFindHandle, LFileData) = False;

    Windows.FindClose(LFindHandle);
  end;
end;

//-----------------------------------------------------------------------------
//  ノードからフルパスを求める(最後尾にデリミタ付加)
//  FRootFolder(グローバル変数)はルートフォルダ名
//-----------------------------------------------------------------------------
function TForm1.GetFullPathFromNode(Node: TTreeNode): String;
var
  LNowNode    : TTreeNode;
  LCnt        : Integer;
  LSearchPath : String;
  i           : Integer;
begin
  LNowNode := Node;
  LCnt := LNowNode.Level;
  LSearchPath := '';

  for i := 0 to LCnt do begin
    LSearchPath := IncludeTrailingPathDelimiter(LNowNode.Text) + LSearchPath;
    LNowNode := LNowNode.Parent;
  end;

  LSearchPath := IncludeTrailingPathDelimiter(FRootFolder) + LSearchPath;
  LSearchPath := IncludeTrailingPathDelimiter(LSearchPath);
  Result := LSearchPath;
end;

end.

02_フォルダの一覧表示 - ファイルも表示

指定フォルダ内の検索で，ファイルもツリーノードに追加するようにしたサンプルです．そのために，前項のサンプルの以下のコードを除外しています．

  if BOOL(LAttrib and FILE_ATTRIBUTE_DIRECTORY) then begin

本サンプルでは，ルートフォルダも TTreeView に表示するようにしています．また，アイコン取得の処理を関数にしています．

	図3 設計時画面ルートフォルダを指定する Button このルートフォルダ以下をツリー表示するフォルダを表示する TTreeView のみ配置
	図4 実行結果例 Button1 でルートとなるフォルダを選択プロジェクトフォルダ下の AAA をルートにしたファイルも表示されている

リスト2
ルートノードを表示して，ファイルも表示するようにしたフォルダツリー表示

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Button1: TButton;
    TreeView1: TTreeView;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
  private
    { Private 宣言 }
    FRootFolder   : String;
    FRootNode     : TTreeNode;
    procedure SetFolderListToTreeView(APath: String; Node: TTreeNode;
      Flag: Boolean);
    function GetFullPathFromNode(Node: TTreeNode): String;
    function GetFileIconIndex(AFileName: String; OPenFlag: Boolean): Integer;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses 
  FileCtrl, 
  ShellAPI, 
  CommCtrl;

{$R *.dfm}

//=============================================================================
//  各ノードのアイコンにTImageListを使わずに，システムのイメージリストを取得し
//  てTreeView1のイメージリストに割当てる
//  usseにShellAPI,CommCtrlが必要
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LSHFileInfo    : TSHFileInfo;
  LImgListHandle : THandle;
begin
  //コモンコントロールのイニシャライズ
  InitCommonControls;
  //システムのイメージリストのハンドルを取得
  LImgListHandle := SHGetFileInfo(
    '',
    0,
    LSHFileInfo,
    SizeOf(LSHFileInfo),
    SHGFI_ICON or SHGFI_SMALLICON or SHGFI_OPENICON or SHGFI_SYSICONINDEX);

  TreeView_SetImageList(TreeView1.Handle, LImgListHandle, TVSIL_NORMAL);
  TreeView1.Items.Clear;

  //テスト用にこのプロジェクトのフォルダをルートとして選択可能にしておく
  FRootFolder := ExtractFilePath(Application.ExeName) + 'AAA';
  TreeView1.ShowRoot := False;
end;

//=============================================================================
//  検索開始
//  FRootFolder(グローバル変数)は検索開始フォルダ名(ルートフォルダ)
//
//  SelectDirectoryの使用にはusesにFileCtrlが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if SelectDirectory('検索フォルダ指定', '', FRootFolder, []) then begin
    Screen.Cursor := crHourGlass;
    TreeView1.Items.BeginUpdate;

    FRootFolder := IncludeTrailingPathDelimiter(FRootFolder);

    TreeView1.Items.Clear;
    //ルートノードも表示してみる
    FRootNode := TreeView1.Items.AddChild(nil, FRootFolder);
    //ルートノードのテキストやアイコン
    if FRootFolder = ExtractFileDir(FRootFolder) then begin
      //ドライブの場合
      FRootNode.Text := FRootFolder;
    end else begin
      FRootNode.Text := ExtractFileName(ExcludeTrailingPathDelimiter(FRootFolder));
    end;
    FRootNode.ImageIndex    := GetFileIconIndex(FRootFolder, False);
    FRootNode.SelectedIndex := GetFileIconIndex(FRootFolder, True);

    //ツリービュー作成
    SetFolderListToTreeView(FRootFolder, FRootNode, True);
    FRootNode.Expand(False);

    TreeView1.Items.EndUpdate;

    Screen.Cursor := crDefault;
  end;

  TreeView1.SetFocus;
end;

//=============================================================================
//  TTreeViewのOnExpandingイベント処理
//  ノードを展開しようとした時
//  [+]ボタンが表示されていても実際に下位フォルダを取得していない時は取得
//  引数のNodeは，これから展開するノード
//=============================================================================
procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
  var AllowExpansion: Boolean);
var
  LFullPath : String;
begin
  if Node.HasChildren then begin
    if Node.Count = 0 then begin
      Screen.Cursor := crHourGlass;
      TTreeView(Sender).Items.BeginUpdate;

      LFullPath := GetFullPathFromNode(Node);
      SetFolderListToTreeView(LFullPath, Node, True);

      TTreeView(Sender).Items.EndUpdate;
      Screen.Cursor := crDefault;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  フォルダの検索ルーチン
//  特殊フォルダの展開はできないの注意
//  1つ下の階層まで検索するが，1つ下の階層のフォルダはノードに追加はしない
//  フォルダが存在する印[+]をノードに追加するだけとする(高速にするため)
//  実際のノードの追加は，OnExpandingイベント内で実行する
//
//  APath : 検索フォルダ名．最後尾にデリミタが必要
//  ANode : 検索フォルダに該当するTreeViewのノード
//  Flag  : True  フォルダ内を全て検索
//          False フォルダ1つでも見つかったら検索終了(再帰処理用)
//-----------------------------------------------------------------------------
procedure TForm1.SetFolderListToTreeView(APath: String; Node: TTreeNode;
  Flag: Boolean);
var
  LSearchPath : String;
  LAddNode    : TTreeNode;
  LFindHandle : THandle;
  LFileName   : String;
  LFileData   : TWin32FindData;
begin
  LFindHandle := FindFirstFile(PChar(APath + '*.*'), LFileData);

  if LFindHandle <> INVALID_HANDLE_VALUE then begin
    repeat
      LFileName := LFileData.cFileName;

      if not ((LFileName = '..') or (LFileName = '.')) then begin
        LSearchPath := IncludeTrailingPathDelimiter(APath) + LFileName;

        //下の階層は一回だけサーチ
        if Flag = False then begin
          //下の階層にもフォルダまたはファイルがあれば[+]ボタンを表示
          if Node <> nil then Node.HasChildren := True;
          break;
        end else begin
          LAddNode := TreeView1.Items.AddChild(Node, LFileName);
          LAddNode.ImageIndex    := GetFileIconIndex(LSearchPath, False);
          LAddNode.SelectedIndex := GetFileIconIndex(LSearchPath, True);
          LSearchPath := IncludeTrailingPathDelimiter(LSearchPath);

          //この下位のフォルダを再帰検索
          SetFolderListToTreeView(LSearchPath, LAddNode, False);
        end;
      end;
    until FindNextFile(LFindHandle, LFileData) = False;

    Windows.FindClose(LFindHandle);
  end;
end;

//-----------------------------------------------------------------------------
//  フォルダまたはファイルのアイコンインデックスを取得
//  OpenFlag=Trueにすると開いてフォルダのアイコンのインデックス取得となる
//  FRootFolder(グローバル変数)はルートフォルダ名
//-----------------------------------------------------------------------------
function TForm1.GetFileIconIndex(AFileName: String; OPenFlag: Boolean): Integer;
var
  LSHFileInfo : TSHFileInfo;
  LuFlags     : Cardinal;
begin
  LuFlags := SHGFI_SMALLICON or SHGFI_ICON or SHGFI_SYSICONINDEX;
  if OPenFlag then begin
    LuFlags := LuFlags or SHGFI_OPENICON;
  end;

  SHGetFileInfo(PChar(AFileName), 0, LSHFileInfo, SizeOf(LSHFileInfo), LuFlags);
  Result := LSHFileInfo.iIcon;
end;

//-----------------------------------------------------------------------------
//  ノードからフルパスを求める(最後尾にデリミタ付加)
//  FRootFolder(グローバル変数)はルートフォルダ名
//-----------------------------------------------------------------------------
function TForm1.GetFullPathFromNode(Node: TTreeNode): String;
var
  LNowNode    : TTreeNode;
  LCnt        : Integer;
  LSearchPath : String;
  i           : Integer;
begin
  LNowNode :=Node;
  LCnt:=LNowNode.Level;
  LSearchPath:='';

  for i := 0 to LCnt - 1 do begin
    LSearchPath := IncludeTrailingPathDelimiter(LNowNode.Text) + LSearchPath;
    LNowNode := LNowNode.Parent;
  end;

  LSearchPath := IncludeTrailingPathDelimiter(FRootFolder) + LSearchPath;
  LSearchPath := IncludeTrailingPathDelimiter(LSearchPath);
  Result := LSearchPath;
end;

end.

03_フォルダの一覧表示 - フォルダ・ファイル順に表示

同じように，フォルダとファイルを表示しますが，まずフォルダを検索し，次にファイルを検索してツリー表示にしたものです．フォルダとファイルの検索ルーチンは別々にしています．
ファイルをリストに追加するかの指定を，グローバル変数として実装してみました．

	図5 設計時画面ルートフォルダを指定する　Button このルートフォルダ以下をツリー表示するフォルダを表示する TTreeView のみ配置
	図6 実行結果例 Button1 でルートフォルダを選択プロジェクトフォルダ下の AAA をルートとしたフォルダの次にファイルを表示

リスト3
ルートノードを表示して，フォルダ・ファイル順に表示するフォルダツリー表示
ファイルを表示を指定するグローバル変数を実装

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Button1: TButton;
    TreeView1: TTreeView;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
  private
    { Private 宣言 }
    FRootFolder   : String;
    FRootNode     : TTreeNode;
    FIsFileList   : Boolean;
    procedure SetFolderListToTreeView(APath: String; Node: TTreeNode;
      Flag: Boolean);
    procedure SetFilesListToTreeView(APath: String; Node: TTreeNode);
    function GetFullPathFromNode(Node: TTreeNode): String;
    function GetFileIconIndex(AFileName: String; OPenFlag: Boolean): Integer;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses 
  FileCtrl, 
  ShellAPI, 
  CommCtrl;

{$R *.dfm}

//=============================================================================
//  各ノードのアイコンにTImageListを使わずに，システムのイメージリストを取得し
//  てTreeView1のイメージリストに割当てる
//  usseにShellAPI,CommCtrlが必要
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LSHFileInfo    : TSHFileInfo;
  LImgListHandle : THandle;
begin
  //コモンコントロールのイニシャライズ
  InitCommonControls;
  //システムのイメージリストのハンドルを取得
  LImgListHandle := SHGetFileInfo(
    '',
    0,
    LSHFileInfo,
    SizeOf(LSHFileInfo),
    SHGFI_ICON or SHGFI_SMALLICON or SHGFI_OPENICON or SHGFI_SYSICONINDEX);

  TreeView_SetImageList(TreeView1.Handle, LImgListHandle, TVSIL_NORMAL);
  TreeView1.Items.Clear;

  //テスト用にこのプロジェクトのフォルダをルートとして選択可能にしておく
  FRootFolder := ExtractFilePath(Application.ExeName) + 'AAA';
  TreeView1.ShowRoot := False;

  //ファイルのリストも取得するかの設定
  FIsFileList := True;
end;

//=============================================================================
//  検索開始
//  FRootFolder(グローバル変数)は検索開始フォルダ名(ルートフォルダ)
//
//  SelectDirectoryの使用にはusesにFileCtrlが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if SelectDirectory('検索フォルダ指定', '', FRootFolder, []) then begin
    Screen.Cursor := crHourGlass;
    TreeView1.Items.BeginUpdate;

    FRootFolder := IncludeTrailingPathDelimiter(FRootFolder);

    TreeView1.Items.Clear;
    //ルートノードも表示してみる
    FRootNode := TreeView1.Items.AddChild(nil, FRootFolder);
    //ルートノードのテキストやアイコン
    if FRootFolder = ExtractFileDir(FRootFolder) then begin
      //ドライブの場合
      FRootNode.Text := FRootFolder;
    end else begin
      FRootNode.Text := ExtractFileName(ExcludeTrailingPathDelimiter(FRootFolder));
    end;
    FRootNode.ImageIndex    := GetFileIconIndex(FRootFolder, False);
    FRootNode.SelectedIndex := GetFileIconIndex(FRootFolder, True);

    //ツリービュー作成
    SetFolderListToTreeView(FRootFolder, FRootNode, True);
    if FIsFileList then SetFilesListToTreeView(FRootFolder, FRootNode);
    FRootNode.Expand(False);

    TreeView1.Items.EndUpdate;

    Screen.Cursor := crDefault;
  end;

  TreeView1.SetFocus;
end;

//=============================================================================
//  TTreeViewのOnExpandingイベント処理
//  ノードを展開しようとした時
//  [+]ボタンが表示されていても実際に下位フォルダを取得していない時は取得
//  引数のNodeは，これから展開するノード
//=============================================================================
procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
  var AllowExpansion: Boolean);
var
  LFullPath : String;
begin
  if Node.HasChildren then begin
    if Node.Count = 0 then begin
      Screen.Cursor := crHourGlass;
      TTreeView(Sender).Items.BeginUpdate;

      LFullPath := GetFullPathFromNode(Node);
      SetFolderListToTreeView(LFullPath, Node, True);
      if FIsFileList then SetFilesListToTreeView(LFullPath, Node);

      TTreeView(Sender).Items.EndUpdate;
      Screen.Cursor := crDefault;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  フォルダの検索ルーチン
//  特殊フォルダの展開はできないの注意
//  1つ下の階層まで検索するが，1つ下の階層のフォルダはノードに追加はしない
//  フォルダが存在する印[+]をノードに追加するだけとする(高速にするため)
//  実際のノードの追加は，OnExpandingイベント内で実行する
//
//  APath : 検索フォルダ名．最後尾にデリミタが必要
//  ANode : 検索フォルダに該当するTreeViewのノード
//  Flag  : True  フォルダ内を全て検索
//          False フォルダ1つでも見つかったら検索終了(再帰処理用)
//-----------------------------------------------------------------------------
procedure TForm1.SetFolderListToTreeView(APath: String; Node: TTreeNode;
  Flag: Boolean);
var
  LSearchPath : String;
  LAddNode    : TTreeNode;
  LFindHandle : THandle;
  LFileName   : String;
  LAttrib     : DWORD;
  LFileData   : TWin32FindData;
  LFlag       : Boolean;
begin
  LFindHandle := FindFirstFile(PChar(APath + '*.*'), LFileData);

  if LFindHandle <> INVALID_HANDLE_VALUE then begin
    repeat
      LFileName := LFileData.cFileName;
      LAttrib   := LFileData.dwFileAttributes;

      LFlag := FIsFileList or BOOL(LAttrib and FILE_ATTRIBUTE_DIRECTORY);
      if not ((LFileName = '..') or (LFileName = '.')) and LFlag then begin
        LSearchPath := IncludeTrailingPathDelimiter(APath) + LFileName;

        //下の階層は一回だけサーチ
        if Flag = False then begin
          //下の階層にもフォルダかファイルがあれば[+]ボタンを表示
          if Node <> nil then Node.HasChildren := True;
          break;
        end else begin
          if BOOL(LAttrib and FILE_ATTRIBUTE_DIRECTORY) then begin
            LAddNode := TreeView1.Items.AddChild(Node, LFileName);

            LAddNode.ImageIndex    := GetFileIconIndex(LSearchPath, False);
            LAddNode.SelectedIndex := GetFileIconIndex(LSearchPath, True);
            LSearchPath := IncludeTrailingPathDelimiter(LSearchPath);

            //この下位のフォルダを再帰検索
            SetFolderListToTreeView(LSearchPath, LAddNode, False);
          end;
        end;
      end;
    until FindNextFile(LFindHandle, LFileData) = False;

    Windows.FindClose(LFindHandle);
  end;
end;

//-----------------------------------------------------------------------------
//  引数で指定するフォルダ内のファイルだけを検索してツリーに追加
//
//  APath : 検索フォルダ名．最後尾にデリミタが必要
//  Node  : 検索フォルダに該当するTreeViewのノード
//-----------------------------------------------------------------------------
procedure TForm1.SetFilesListToTreeView(APath: String; Node: TTreeNode);
var
  LSearchPath : String;
  LAddNode    : TTreeNode;
  LFindHandle : THandle;
  LFileName   : String;
  LAttrib     : DWORD;
  LFileData   : TWin32FindData;
begin
  LFindHandle := FindFirstFile(PChar(APath + '*.*'), LFileData);

  if LFindHandle <> INVALID_HANDLE_VALUE then begin
    repeat
      LFileName := LFileData.cFileName;
      LAttrib   := LFileData.dwFileAttributes;

      if not ((LFileName = '..') or (LFileName = '.')) then begin
        if not (BOOL(LAttrib and FILE_ATTRIBUTE_DIRECTORY)) then begin
          LSearchPath := IncludeTrailingPathDelimiter(APath) + LFileName;

          LAddNode := TreeView1.Items.AddChild(Node, LFileName);
          LAddNode.ImageIndex    := GetFileIconIndex(LSearchPath, False);
          LAddNode.SelectedIndex := LAddNode.ImageIndex;
        end;
      end;
    until FindNextFile(LFindHandle, LFileData) = False;

    Windows.FindClose(LFindHandle);
  end;
end;

//-----------------------------------------------------------------------------
//  フォルダまたはファイルのアイコンインデックスを取得
//  OpenFlag=Trueにすると開いてフォルダのアイコンのインデックス取得となる
//  FRootFolder(グローバル変数)はルートフォルダ名
//-----------------------------------------------------------------------------
function TForm1.GetFileIconIndex(AFileName: String; OPenFlag: Boolean): Integer;
var
  LSHFileInfo : TSHFileInfo;
  LuFlags     : Cardinal;
begin
  LuFlags := SHGFI_SMALLICON or SHGFI_ICON or SHGFI_SYSICONINDEX;
  if OPenFlag then begin
    LuFlags := LuFlags or SHGFI_OPENICON;
  end;

  SHGetFileInfo(PChar(AFileName), 0, LSHFileInfo, SizeOf(LSHFileInfo), LuFlags);
  Result := LSHFileInfo.iIcon;
end;

//-----------------------------------------------------------------------------
//  ノードからフルパスを求める(最後尾にデリミタ付加)
//  FRootFolder(グローバル変数)はルートフォルダ名
//-----------------------------------------------------------------------------
function TForm1.GetFullPathFromNode(Node: TTreeNode): String;
var
  LNowNode    : TTreeNode;
  LCnt        : Integer;
  LSearchPath : String;
  i           : Integer;
begin
  LNowNode :=Node;
  LCnt:=LNowNode.Level;
  LSearchPath:='';

  for i := 0 to LCnt - 1 do begin
    LSearchPath := IncludeTrailingPathDelimiter(LNowNode.Text) + LSearchPath;
    LNowNode := LNowNode.Parent;
  end;

  LSearchPath := IncludeTrailingPathDelimiter(FRootFolder) + LSearchPath;
  LSearchPath := IncludeTrailingPathDelimiter(LSearchPath);
  Result := LSearchPath;
end;

end.

04_フォルダの一覧表示 - 指定フォルダを選択状態にする

上のサンプルに，下のような，指定フォルダを選択状態にする関数を追加したサンプルです．
このサンプルでは，ツリー表示の直後に，TEdit に入力したフォルダを選択します．ルートフォルダより上の階層は選択できません．その場合はルートノードを選択状態します．
ファイルもツリー表示するようにすれば，ファイルの選択もできます．

本サンプルにも，これまでのサンプルにも，GetFullPathFromNode という，選択中のノードからフルパスを取得する関数を実装しています．本サンプルで追加した，指定フォルダの選択の機能もあれば，自前の「フォルダの選択ダイアログ」を作成することも可能でしょう．

    function GetFullPathFromNode(Node: TTreeNode): String;

[備考]
項目識別子を使用したフォルダのツリー表示では，表示名と実フォルダ名が異なる場合があります．
そのため，TTreeView の各アイテム (TTreeNode 型) の Data プロパティに，項目識別子の値やフルパスの値を代入する方法も使われているようです．

	図7 設計時画面
	図8 ルートフォルダを指定してツリー表示 TEdit に入力したフォルダを選択する

リスト4
指定フォルダを選択状態にする関数

//-----------------------------------------------------------------------------
//  指定したフォルダまたはファイルを選択状態にする関数
//  引数は選択するフォルダまたはファイルのフルパス
//  戻り値は選択したノード
//  指定したフォルダが存在しない場合ルートノードまたは最初のノードを返す
//  指定したファイルが存在しない場合はそのファイルがあるフォルダのノードを返す
//  
//  コード中のグローバル変数
//  FRootFolder : ルートフォルダ
//  FRootNode   : ルートフォルダに相当するノード(ルートを表示しない場合はnil)
//
//  usesにStrUtilsが必要
//-----------------------------------------------------------------------------
function TForm1.SelectionFolderNode(ASelectFolder: String): TTreeNode;
var
  i          : Integer;
  LPathArray : TStringList;
  LTreeNode  : TTreeNode;
begin
  Result := TreeView1.Items[0];

  //末尾のデリミタを削除
  ASelectFolder := ExcludeTrailingPathDelimiter(ASelectFolder);
  if not DirectoryExists(ASelectFolder) then begin
    if not FileExists(ASelectFolder) then exit;
  end;
  if not ContainsText(ASelectFolder, FRootFolder) then exit;

  ASelectFolder := StringReplace(ASelectFolder, FRootFolder, '', [rfIgnoreCase]);

  LPathArray := TStringList.Create;
  try
    //パスを各フォルダ名に分解する
    LPathArray.Delimiter := '\';
    LPathArray.StrictDelimiter := True;
    LPathArray.DelimitedText   := ASelectFolder;

    if FRootNode = nil then begin
      //ルートノードを表示していない場合
      LTreeNode := TreeView1.Items[0];
    end else begin
      FRootNode.Expand(False);
      LTreeNode := TreeView1.Items[0].getFirstChild;
    end;


    for i := 0 to LPathArray.Count - 1 do begin
      if LTreeNode = nil then break;
      while LTreeNode <> nil do begin
        if LTreeNode.Text = LPathArray[i] then begin
          Result := LTreeNode;
          break;
        end;
        LTreeNode := LTreeNode.getNextSibling;
      end;
      //最後のフォルダは展開しない
      if LTreeNode.HasChildren and (i < (LPathArray.Count - 1)) then begin
        LTreeNode.Expand(False);
        LTreeNode := LTreeNode.getFirstChild;
      end;
    end;
  finally
    FreeAndNil(LPathArray);
  end;

  Result.Selected := True;
  //選択ノードを見える位置にする
  TreeView1.Selected.MakeVisible;
end;

05_エクスプローラからのドラッグ・アンド・ドロップ

エクスプローラからのドラッグ・アンド・ドロップで，フォルダにコピーするサンプルです．

(1) エクスプローラからのドラッグ・アンド・ドロップを受け付けるコードを追加
(2) ドラッグしてきて，マウスカーソルがノードにきたら，そのノードを選択状態にする
(3) ドロップしたら，そのノードに相当するフォルダにコピーする

という手順になります．
そのために，マウスの移動をグローバルフックしなければなりません．このフックに，ローレベルのマウスフック関数を使用しています．これだと DLL にする必要がありません．
ドラッグ・アンド・ドロップは，そのままでは Windows Vista 以降で機能しない場合があります．その対応策としてのコードを追加しています．
DLL にしなくても動作するグローバルフックとして，WH_JOURNALRECORD がありますが，このフックは Vista 以降の OS では管理者権限で実行しても有効となりません．

このサンプルでは，ボタンをクリックして表示するフォルダは，プロジェクト内の AAA というフォルダに固定しています．このフォルダの階層下のフォルダにドロップすることになります．

ドラッグ・アンド・ドロップの機能の実装には，IDropSource インターフェイスや IDropTarget インターフェイスを使用する方法もあります．

	図9 設計時画面
	図10 実行中 [Button1] をクリックエクスプローラからドラッグしてドロップ

リスト5
エクスプローラからのドラッグ・アンド・ドロップ

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Button1: TButton;
    TreeView1: TTreeView;
    ApplicationEvents1: TApplicationEvents;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Button1Click(Sender: TObject);
    procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
    procedure ApplicationEvents1Deactivate(Sender: TObject);
  protected
    procedure WMApp100(var Message: TMessage); message WM_APP+100;
  private
    { Private 宣言 }
    FRootFolder : String;
    LRootNode : TTreeNode;
    procedure SetFolderListToTreeView(APath: String; Node: TTreeNode;
      Flag: Boolean);
    function GetFullPathFromNode(Node: TTreeNode): String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses 
  FileCtrl, 
  ShellAPI, 
  CommCtrl;

//-------------------------------------------------
//  低レベルマウスフックのキー情報構造体
//-------------------------------------------------

type
  LPMSLLHOOKSTRUCT = ^MSLLHOOKSTRUCT;
  tagMSLLHOOKSTRUCT = record
    pt: TPOINT;
    mouseData: DWORD;
    flags: DWORD;
    time: DWORD;
    dwExtraInfo: ULONG_PTR;
  end;
  MSLLHOOKSTRUCT = tagMSLLHOOKSTRUCT;
  TMsllHookStruct = MSLLHOOKSTRUCT;
  PMsllHookStruct = LPMSLLHOOKSTRUCT;

//-------------------------------------------------
//  ChangeWindowMessageFilter関数用の定数
//  Microsoft Windows SDK 7.1 より抜粋
//  * Message Filter
//  #define MSGFLT_ADD 1
//  #define MSGFLT_REMOVE 2
//  WM_COPYGLOBALDATAは非公開メッセージ
//-------------------------------------------------
const
  MSGFLT_ADD        = 1;
  MSGFLT_REMOVE     = 2;
  WM_COPYGLOBALDATA = $0049;

var
  MouseHookHandle : HHOOK;
  MsgStr : String;

{$R *.dfm}

//-----------------------------------------------------------------------------
//  WH_MOUSE_LL マウスフックのコールバック関数
//-----------------------------------------------------------------------------
function LowLevelMouseProc(Code: Integer; wPar: wParam; lPar:LParam):
  Integer; stdcall;
begin
  if Code < 0 then begin
    Result := CallNextHookEx(MouseHookHandle, Code, wPar, lPar);
    exit;
  end;
  if Code = HC_ACTION then begin
    PostMessage(Form1.Handle, WM_APP+100, wPar, lPar);
  end;

  Result := CallNextHookEx(MouseHookHandle, Code, wPar, lPar);
end;

//=============================================================================
//  Form1のOnCreateイベント処理
//
//  各ノードのアイコンにTImageListを使わずに，システムのイメージリストを取得し
//  てTreeView1のイメージリストに割当てる
//  usseにShellAPI,CommCtrlが必要
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LDLLHandle     : THandle;
  LFuncFilter    : function (msg: Cardinal; dwFlag: DWORD): BOOL; stdcall;
  LSHFileInfo    : TSHFileInfo ;
  LImgListHandle : THandle;
begin
  //---------------------------------------------------------------------------
  //  低い権限で実行したアプリ(エクスプローラ等)からのドラッグ&ドロップを受付
  //  可能にする(Windows Vista以降用)
  //  関数ChangeWindowMessageFilterは，Windows XP以前にはないのでGetProcAddress
  //  で確認する必要がある
  //  CheckWin32VersionでVista以降かを判定しているので，実際には不要
  //---------------------------------------------------------------------------
  if CheckWin32Version(6, 0) then begin
    LDLLHandle := loadLibrary('user32.dll');
    try
      if LDLLHandle > 0 then begin
        @LFuncFilter := GetProcAddress(LDLLHandle, 'ChangeWindowMessageFilter');
        if @LFuncFilter <> nil then begin
          LFuncFilter(WM_DROPFILES,      MSGFLT_ADD);
          LFuncFilter(WM_COPYDATA,       MSGFLT_ADD);
          LFuncFilter(WM_COPYGLOBALDATA, MSGFLT_ADD);
        end;
      end;
    finally
      FreeLibrary(LDLLHandle);
    end;
  end;

  //ListView1ムへのドラッグアンドドロップを許可
  DragAcceptFiles(TreeView1.Handle, True);

  //システムのイメージリストのハンドルを取得
  LImgListHandle := SHGetFileInfo(
                     '',
                     0,
                     LSHFileInfo,
                     SizeOf(LSHFileInfo),
                     SHGFI_ICON or
                     SHGFI_SMALLICON or SHGFI_OPENICON or SHGFI_SYSICONINDEX);

  TreeView_SetImageList(TreeView1.Handle, LImgListHandle, TVSIL_NORMAL);
  TreeView1.Items.Clear;
end;

//=============================================================================
//  Form1のOnCloseQueryイベント処理
//
//  念のためにフォームを閉じる時はフック終了コード実行
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  UnhookWindowsHookEx(MouseHookHandle);
  MouseHookHandle := 0;
end;

//=============================================================================
//  フォルダ内のファイルを検索開始
//  このプロジェクトのAAAというフォルダ内をツリー表示する
//  FRootFolder(グローバル変数)は検索開始フォルダ名(ルートフォルダ)
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  TreeView1.Items.BeginUpdate;

  TreeView1.Items.Clear;
  Screen.Cursor := crHourGlass;

  FRootFolder := ExtractFilePath(Application.ExeName) + 'AAA\';
  LRootNode := nil;
  SetFolderListToTreeView(FRootFolder, LRootNode, True);

  Screen.Cursor := crDefault;
  TreeView1.Items.EndUpdate;
end;

//=============================================================================
//  TTreeViewのOnExpandingイベント処理
//
//  ノードが展開しようとした時
//  [+]ボタンが表示されていても実際に下位フォルダを取得していない時は取得
//  引数のNodeはこれから展開するノード
//=============================================================================
procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
  var AllowExpansion: Boolean);
var
  LFullPath : String;
begin
  if Node.HasChildren then begin
    if Node.Count = 0 then begin
      Screen.Cursor := crHourGlass;

      TTreeView(Sender).Items.BeginUpdate;
      LFullPath := GetFullPathFromNode(Node);
      SetFolderListToTreeView(LFullPath, Node, True);
      TTreeView(Sender).Items.EndUpdate;

      Screen.Cursor := crDefault;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  フォルダの検索ルーチン
//  検索しながらアイコンを取得して追加
//
//  APath : 検索フォルダ名．最後尾にデリミタが必要
//  Node  : 検索フォルダに該当するTreeViewのノード
//  Flag  : True  フォルダ内を全て検索
//          False フォルダ1つでも見つかったら検索終了
//-----------------------------------------------------------------------------
procedure TForm1.SetFolderListToTreeView(APath: String; Node: TTreeNode;
  Flag:Boolean);
var
  LSearchPath : String;
  LSHFileInfo : TSHFileInfo;
  LAddNode    : TTreeNode;
  LFindHandle : THandle;
  LFileName   : String;
  LAttrib     : DWORD;
  LFileData   : TWin32FindData;
begin
  LFindHandle := FindFirstFile(PChar(APath + '*.*'), LFileData);
  if LFindHandle <> INVALID_HANDLE_VALUE then begin
    repeat
      LFileName := LFileData.cFileName;
      LAttrib   := LFileData.dwFileAttributes;
      if not ((LFileName = '..') or (LFileName = '.')) then begin
        if BOOL(LAttrib and FILE_ATTRIBUTE_DIRECTORY) then begin
          LSearchPath := IncludeTrailingPathDelimiter(APath) + LFileName;
          //下の階層は一回だけサーチ
          if Flag=False then begin
            //下の階層にもフォルダがあれば[+]ボタンを表示
            if Node <> nil then Node.HasChildren := True;
            break;
          end else begin
            LAddNode := TreeView1.Items.AddChild(node, LFileName);

            //ノードのアイコンを取得して設定
            SHGetFileInfo(
              PChar(LSearchPath),
              0,
              LSHFileInfo,
              SizeOf(LSHFileInfo),
              SHGFI_SMALLICON or SHGFI_ICON or SHGFI_SYSICONINDEX);
            LAddNode.ImageIndex := LSHFileInfo.iIcon;

            //ノードを選択した時の開いたアイコンを取得して設定
            SHGetFileInfo(
              PChar(LSearchPath),
              0,
              LSHFileInfo,
              SizeOf(LSHFileInfo),
              SHGFI_SMALLICON or SHGFI_OPENICON or SHGFI_ICON or SHGFI_SYSICONINDEX);
            LAddNode.SelectedIndex := LSHFileInfo.iIcon;

            LSearchPath := IncludeTrailingPathDelimiter(LSearchPath);

            //この下位のフォルダを再帰検索
            SetFolderListToTreeView(LSearchPath, LAddNode, False);
          end;
        end;
      end;
    until FindNextFile(LFindHandle, LFileData) = False;

    Windows.FindClose(LFindHandle);
  end;
end;

//-----------------------------------------------------------------------------
//  ノードからフルパスを求める(最後尾にデリミタ付加)
//  FRootFolder(グローバル変数)はルートフォルダ名
//-----------------------------------------------------------------------------
function TForm1.GetFullPathFromNode(Node: TTreeNode): String;
var
  LNowNode    : TTreeNode;
  LCnt        : Integer;
  LSearchPath : String;
  i           : Integer;
begin
  LNowNode    := Node;
  LCnt        := LNowNode.Level;
  LSearchPath := '';

  for i := 0 to LCnt do begin
    LSearchPath := IncludeTrailingPathDelimiter(LNowNode.Text) + LSearchPath;
    LNowNode    := LNowNode.Parent;
  end;

  LSearchPath := IncludeTrailingPathDelimiter(FRootFolder) + LSearchPath;
  LSearchPath := IncludeTrailingPathDelimiter(LSearchPath);
  Result     := LSearchPath;
end;

//=============================================================================
//  TApplicationEventsのOnMessageイベント処理
//
//  エクスプローラからのファイルのドラッグ・ドロップ処理
//  Windows APIのWM_DROPFILESでメッセージ処理をする方法もあるが，Form全体に対し
//  て有効となってしまう
//  TApplicationでメッセージ処理すれば，コントロール別に受入れ方を設定可能
//
//  マウスの左ボタンを放したら，メニューでコピーとか移動を選択するようにするの
//  も良いかも知れない
//=============================================================================
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
var
  i         : Integer;
  LCount    : Integer;
  LBuf      : array [0..MAX_PATH-1] of char;
  LFileName : String;
  LDestPath : String;
  LPath1    : String;
  LPath2    : String;
  LFileOp   : TSHFileOpStruct;
  LFiles    : String;
  LFlag     : FILEOP_FLAGS;
begin
  if Msg.message = WM_DROPFILES then begin
    //ドロップしたらフック解除
    if MouseHookHandle > 0 then begin
      UnhookWindowsHookEx(MouseHookHandle);
      MouseHookHandle := 0;
    end;

    //FormのOnCreateで受入れコントロールを指定はしているが...
    if FindDragTarget(Msg.pt,False) = TreeView1 then begin
      LCount := DragQueryFile(Msg.wParam, $FFFFFFFF, nil, 0);

      //コピー元ファイルリスト生成
      LFiles := '';
      for i := 0 to LCount - 1 do begin
        DragQueryFile(Msg.WParam, i, LBuf, MAX_PATH);
        if i = 0 then LPath1 := LBuf;

        LFileName := LBuf;
        LFiles    := LFiles + LFileName + #0;
      end;
      LFiles := LFiles + #0;

      //ドロップが完了したことを伝える
      DragFinish(msg.WParam);
      //アクティブにする
      SetForegroundWindow(Handle);

      //TShFileOpStruct構造体の各値を設定
      //同一フォルダ内の場合は[コピー～]を付加
      //他のフォルダの場合，既に同名のものがあればダイアログ表示
      if TreeView1.SelectionCount = 0 then exit;

      LDestPath := GetFullPathFromNode(TreeView1.Selected);
      LDestPath := ExcludeTrailingPathDelimiter(LDestPath);

      LPath2 := FRootFolder + ExtractFileName(LPath1);
      if LPath1 = LPath2 then begin
        LFlag := FOF_NOCONFIRMMKDIR or FOF_RENAMEONCOLLISION;
      end else begin
        LFlag := FOF_NOCONFIRMMKDIR;
      end;

      with LFileOp do begin
        Wnd    := Handle;
        wFunc  := FO_COPY;
        pFrom  := PChar(LFiles);
        pTo    := PChar(LDestPath + #0);
        fFlags := LFlag;
      end;

      try
        //失敗またはキャンセルした場合の内容はSHFileOperationの戻値で判定可能
        if SHFileOperation(LFileOp) = 0 then begin
          //フォルダをコピーしたかも知れないので検索
          //ただし展開はしない(最後の引数をFalseにする)
          SetFolderListToTreeView(LDestPath, TreeView1.Selected, False);
        end else begin
          TreeView1.SetFocus;
          Application.MessageBox('コピーを中断しました', '情報', MB_OK);
        end;
      except
        TreeView1.SetFocus;
        Application.MessageBox('コピーに失敗しました', '情報', MB_OK);
      end;
    end;
  end;
end;

//=============================================================================
//  TApplicationEventsのOnDeactivateイベント処理
//  フォームが非アクティブになったらフック開始
//=============================================================================
procedure TForm1.ApplicationEvents1Deactivate(Sender: TObject);
begin
  if (MouseHookHandle = 0) and (TreeView1.Items.Count > 0) then begin
    MouseHookHandle := SetWindowsHookEx(WH_MOUSE_LL,
                                        @LowLevelMouseProc,
                                        hInstance,
                                        0);
  end;
end;

//-----------------------------------------------------------------------------
//  ローレベルマウスフックからのメッセージを処理する
//  マウスカーソルがノードにきたら，それを選択する
//
//  TApplicationEventsのOnMessageイベントでも処理可能だが，ここでは別にした
//-----------------------------------------------------------------------------
procedure TForm1.WMApp100(var Message: TMessage);
var
  LCurPos   : TPoint;
  LMousePos : TPoint;
  LNode     : TTreeNode;
begin
  case Message.WParam of
  WM_MOUSEMOVE:
    begin
      GetCursorPos(LCurPos);
      LMousePos := TreeView1.ScreenToClient(LCurPos);
      LNode    := TreeView1.GetNodeAt(LMousePos.X, LMousePos.Y);

      if LNode <> nil then begin
        PostMessage(TreeView1.Handle, WM_SETFOCUS, 0, 0);
        LNode.Selected := True;
      end;
    end;
  end;
end;

end.

06_TTreeView の展開折りたたみボタンを [+] [-] の画像にする

下図は，本ページの最初のサンプルを Windows XP で実行した結果です．ノードの展開折りたたみのボタンが [+] [-] の画像になっています．本ページの記事掲載当初は，動作確認環境が Windows XP でしたから，このような画像を掲載していたことになります．

展開 / 折りたたみボタンの矢印 (三角形) は Windows Vista で実装された Theme (テーマ) による描画です．Windows Vista に対応した Delphi 2007 からは，このテーマによる描画がデフォルトの設定になっています．

参考リンク
Delphi 7 以降の VCL の新機能 - Delphi 2007 時点

図11
最初のサンプルを Windows XP で実行した結果

フォームやコントロール類のデザインは，Theme (テーマ) が提供しています．したがって，ランタイムテーマを無効にすれば，TButton 等もテーマなしの描画になりますが，TTreeView の展開折りたたみボタンも Windows XP の時と同じように [+] [-] になります．
下図は，アプリケーション全体でテーマを無効にするのではなく，TTreeView だけのテーマを無効にした結果です．SetWindowTheme 関数を使用して TreeView1 だけテーマを無効にしています．

[備考 1]
プロジェクトのオプションでランタイムテーマを無効にしたままの状態だと，アプリケーションマニフェストを使用しないことになります．．

参考リンク
[アプリケーションマニフェストの作成と使用]

図12
TreeView1 だけランタイムテーマを無効にした結果

リスト6
SetWindowTheme 関数を使用して TreeView1 だけランタイムテーマを無効にする例
SetWindowTheme 関数の使用には usse に uxTheme が必要

procedure TForm1.FormCreate(Sender: TObject);
var
  LSHFileInfo    : TSHFileInfo;
  LImgListHandle : THandle;
begin
  SetWindowTheme(TreeView1.Handle, nil, nil);

以下のコードは，ランタイムテーマを有効にしたままで展開折りたたみボタンを [+] [-] にする例です．ノードの展開折りたたみボタンの位置に [+] [-] の画像を描画しています．使用した画像は 9 x 9 サイズのビットマップ画像です．
TTreeView の OnAdvancedCustomDrawItem イベント内で描画しています．

[備考 2]
添付のプログラムでは，ビットマップ画像をリソースとしています．プロジェクトをコンパイルするには，あらかじめビットマップ画像ファイルを用意しておく必要があります．
ビットマップ画像のファイル名は VT_XPBUTTONMINUS.bmp, VT_XPBUTTONPLUS.bmp とします．

図13
下のイベントコードを実行した結果

リスト7
TTreeView のノードの展開折たたみボタンを [+] [-] の画像にする

//=============================================================================
//  TreeView1 の OnAdvancedCustomDrawItem イベント処理
//
//  Fbmp_XP_BtnPlus,Fbmp_XP_BtnMinus はグローバル変数で TBitmap
//  サイズは 9 x 9
//=============================================================================
procedure TForm1.TreeView1AdvancedCustomDrawItem(Sender: TCustomTreeView;
  Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
  var PaintImages, DefaultDraw: Boolean);
var
  LLeft : Integer;
  LTop  : Integer;
begin
  DefaultDraw := True;

  if Stage <> cdPostPaint then Exit;
  if not Node.IsVisible then Exit;
  if not TreeView1.ShowButtons then Exit;

  // 展開折りたたみボタンの描画位置
  // 場合によっては描画位置の調整が必要
  LLeft := Node.DisplayRect(True).Left + Treeview1.Indent - 54;
  LTop  := Node.DisplayRect(False).Top + 7;

  if Node.HasChildren then begin
    if Node.Expanded then begin
      TreeView1.Canvas.Draw(LLeft, LTop, Fbmp_XP_BtnMinus);
    end else begin
      TreeView1.Canvas.Draw(LLeft, LTop, Fbmp_XP_BtnPlus);
    end;
  end;
end;

Delphi のインストール先の [Bin] フォルダ内にある vclideXXX.bpl ファイルには，9 x 9 サイズの [+] [-] のビットマップ画像が格納されています．これらのビットマップは，以下のようなコードで取得して保存できます．
XXX の部分は Delphi のバージョンによって異なる数字です．

図14
[+] [-] のビットマップ画像

リスト8
vclideXXX.bpl ファイルから [+] [-] のビットマッ画像を取得して保存するコード

//=============================================================================
//  vclideXXX.bpl から指定リソース名のビットマップ画像を取得して保存
//  vclideXXX.bpl は Delphi のインストール先の [Bin] フォルダ内にある
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LdwFlag       : Cardinal;
  LResouceFile  : string;
  LhModule      : THandle;
  LResIDName    : string;
  LSaveFilePath : string;
  LBitmap       : TBitmap;
begin
  OpenDialog1.Filter := 'bpl ファイル (vclide*.bpl)|vclide*.bpl';
  OpenDialog1.InitialDir := GetEnvironmentVariable('ProgramFiles') + '\Embarcadero';
  if not OpenDialog1.Execute then Exit;

  LResouceFile := OpenDialog1.FileName;

  LdwFlag  := LOAD_LIBRARY_AS_DATAFILE or LOAD_WITH_ALTERED_SEARCH_PATH;
  LhModule := LoadLibraryEx(PChar(LResouceFile), 0, LdwFlag);

  LBitmap := TBitmap.Create;
  try
  　if LhModule <> 0 then begin
      LResIDName    := 'VT_XPBUTTONMINUS';
      LSaveFilePath := ExpandFileName(LResIDName + '.bmp');
      try
        LBitmap.LoadFromResourceName(LhModule, LResIDName);
        LBitmap.SaveToFile(LSaveFilePath);
      except
      end;

      LResIDName    := 'VT_XPBUTTONPLUS';
      LSaveFilePath := ExpandFileName(LResIDName + '.bmp');
      try
        LBitmap.LoadFromResourceName(LhModule, LResIDName);
        LBitmap.SaveToFile(LSaveFilePath);
      except
      end;
    end;
  finally
    FreeLibrary(LhModule);
    FreeAndNil(LBitmap);
  end;
end;

07_TTreeView の展開折りたたみボタンを矢印 ( 三角形 ) にする

Delphi が Theme (テーマ) に対応したのは Delphi 2007 からです．それより前の Delphi 6 / Delphi 7 でもアプリケーションマニフェストを追加すればテーマ対応の描画になりますが，TTreeView 等のコモンコントロールはテーマ対応の描画になりません．テーマによる描画が行われないと，TTreeView のノードの展開折りたたみボタンは [+] [-] の画像となります．

SetWindowTheme 関数の第 2 引数を文字列 Explorer にすると，TTreeView がテーマを使用した描画となります，下図は，アプリケーションマニフェストと SetWindowTheme 関数を使用して，Delphi 6 (UP2) のプログラムをテーマ対応にした例です．

参考リンク
[アプリケーションマニフェストの作成と使用]

	図15 Delphi 6 でコンパイルしたプログラム
	図16 テーマ対応にした Delphi 6 のプログラム

リスト9
TTreeview もテーマ対応にするために Delphi 6 のプロジェクトに追加したコード

  // Windows API の関数を使用するための定義
  // UxTheme.dll 内の SetWindowTheme 関数
  function SetWindowTheme(AHwnd: HWND; pszSubAppName:LPCWSTR;
     pszSubIdList: LPCWSTR): HRESULT; stdcall; external 'UxTheme.dll';


  // TreeView1 をテーマ対応の描画にする   
  // フォームの OnCreate イベント内等で実行する   
  SetWindowTheme(TreeView1.Handle, 'Explorer', nil);

08_VCL Style 使用時の TTreeView の展開折りたたみボタン

VCL Style (VCL スタイル) を使用するとほとんど TTreeView は Theme (ランタイムテーマ) による描画を行わないようです．筆者は VCL Style についての詳しい知識がありませんので，それが VCL Style の仕様なのか TTreeView 特有の仕様なのかは分かりません．

テーマによる描画が行われないと，TTreeView のノードの展開折りたたみボタンは [+] [-] の画像となります．本サンプルは，SetWindowTheme 関数を使用して，TTreeView の描画を，テーマを使用する描画とテーマを使用しない描画を切り換えるテストです．
TTreeView や TListView 等の Windows のコモンコントロールでは，SetWindowTheme 関数の第 2 引数の文字列を Explorer にするとテーマを使用した描画となります．第 2 引数の値を nil にするとテーマによる描画を行いません．

[備考]
SetWindowTheme 関数の第 2 引数の文字列を Explorer にすると，Explorer が使用しているコモンコントロールと同じテーマで描画します．したがって，本項のサンプルを Windows XP で実行しても，展開折りたたみボタンの表示は変化しません．TTreeView の展開折りたたみボタンの表示が変化するのは，Windows Vista 以降で実行した場合です．

	図17 テーマを使用しない時の TTreeeView 展開折りたたみボタンは [+] [-]
	図18 テーマを使用した時の TTreeeView 展開折りたたみボタンは矢印 (三角形)

下図は，TTreeView の背景が暗い色の場合です．テーマを使用した描画では，展開折りたたみボタンが見えにくいようてす．この場合はテーマを使用しない描画の方がいいのかも知れません．

	図19 テーマを使用しない時の TTreeeView 展開折りたたみボタンは [+] [-]
	図20 テーマを使用した時の TTreeeView 展開折りたたみボタンは矢印 (三角形)

リスト10
TTreeView の描画を，テーマ使用しない描画とテーマを使用する描画を切り換える
Delphi XE2 以降専用

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls;

type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    FIsTheme : Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Vcl.Themes,
  Winapi.uxTheme;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  テスト用のツリーアイテムを作成
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
 LRoot  : TTreeNode;
 LNode  : TTreeNode;
 LLoopI : integer;
 LLoopJ : integer;
 LLoopK : integer;
begin
  // VCl Style 未使用でランタイムテーマが有効な場合は True とする
  // uses に Themes が必要
  FIsTheme := not TStyleManager.IsCustomStyleActive and ThemeServices.ThemesEnabled;

  for LLoopJ:=0 to 4 do begin
    LRoot:=TreeView1.Items.Add(nil,IntToStr(LLoopJ));
    for LLoopI:= 0 to 2 do begin
      LNode := TreeView1.Items.AddChild(LRoot, Format('Child %d.%d',[LLoopJ,LLoopI]));
      if LLoopI = 1 then begin
        for LLoopK := 1 to 3 do begin
          TreeView1.Items.AddChild(LNode, Format('Child-Child %d',[LLoopK]));
        end;
      end;
    end;
  end;
end;

//=============================================================================
//  テーマを使用する描画とテーマを使用しない描画を切り換える
//
//  使用している Vcl Style はテーマによる描画はない
//  したがってアプリの起動時は FIsTheme の値は False
//  uses に uxTheme が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if FIsTheme then begin
    // ランタイムテーマによる描画を中止
    SetWindowTheme(TreeView1.Handle, nil, nil);
  end else begin
    // ランタイムテーマによる描画にする
    // TTreeView, TListView 等のコモンコントロールは第 2 引数を Explorer にする
    SetWindowTheme(TreeView1.Handle, 'Explorer', nil);
  end;
  FIsTheme := not FIsTheme;
end;

end.