Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2007年11月11日] [更新 2014年01月09日] Delphi サンプルプログラム集
   
812_フォルダツリーとファイル一覧 ( 簡易エクスプローラの作成 )
動作確認等 Windows 7 U64(SP1) + Delphi XE Pro
ファイル関連ダイアログコンポーネント + コンテキストメニュー コンポーネント
812_ExplorerTest.zip [4,529 KB] 2014年07月17日版(EXE同梱)



コンポーネントのソースコードはダウンロードしたファイルに含まれています.
  • 2008年09月01日
  • コンポーネントの修正に伴い見直し.Vista でテスト
  • 2010年10月31日
  • Delphi 2009 以降で使用可能にするためにコンポーネントを修正
  • リンク先の取得コードを修正
  • アイコンの取得コードを修正
  • ドライブの判定コードを変更
  • CopyFiles を実行しなくても選択中のファイルを CopyFilesList で取得可能にした
  • コンテキストメニューのサンプルを自作コンポを使用したコードに変更
  • 2013年01月09日
  • 拡張子関連付けアプリの検出を ShLwApi.AssocQueryString 関数を使用するコードに変更.この変更で Delphi 2007 より前ではコンパイル不可となった
  • コンポーネントのソースコードを整備
  • 関係する参考記事とそのリンクを追加
  • 2014年07月17日
  • TplFolderTree の SelectFolder プロパティが正常に機能しないバグを修正
  • テストプログラムのコードと EXE の変更はなし




フォルダツリーとファイル一覧 ( 簡易エクスプローラの作成 )


[790_ファイル一覧・仮想リストビュー] と [800_フォルダの一覧表示] で指定フォルダのファイル一覧と,フォルダツリー表示のサンプルを作成しました.これらを組合わせるとエクスプローラのようなものが作成できそうですが,お互いの連携をとるのは結構面倒です.これはコンポーネントにしないと無理がありそうです.
そこで,テスト用にコンポーネントを作成してみました. 作成したコンポーネントでは,フォルダ内のファイルの取得に FindFirst, FindNext 関数を使用しています.これらの関数では GUID で表わされる仮想フォルダや仮想フォルダ内のファイルは取得できません.

添付の plFolderTreeFileList.pas をパスの通ったフォルダに置いて,コンポーネントの登録を行って下さい.コンポーネントのクラス名は,TplFolderTree と TplFileListです.
サンプルプログラムのプロジェクトを使用するには,拙作の [ファイル関連ダイアログコンポーネント] も必要です.別途ダウンロードしてください.
TplFolderTree と TplFileList は各々,単独でも使用できます.

特殊フォルダのフルパスは [460_特殊フォルダのフルパスを取得] のコードを参考にすれば取得することができますが,GUID で表わされる仮想フォルダは展開できません.そのようなフォルダを扱わないのであれば,本ページのサンプルでも十分です.むしろ,そのような仮想フォルダを扱えないのが利点となる場合もあります.
仮想フォルダ階層下の,実フォルダ (ディレクトリ) が存在するフォルダの展開は可能です.





01_ファイルリスト用コンポーネント TplFileList


指定フォルダ内のファイル,フォルダの一覧を取得するコンポーネントです.
クラス名は TplFileList です.継承元は TCustomListView です.
表示形式は「詳細」専用にしていますが [種類] 項目は表示しません.また,仮想リストビューの機能を使用して,表示を高速にしていますが,仮想リストビューは,ファイル情報の取得は高速ですが,アイコンや TListView の Item の描画には多少時間がかかります.そのため,大量データの場合,スクロールがぎこちないことがあります.一度スクロールで全て表示した後はスムーズになります.
以下は,このコンポーネントのプロパティ,メソッド類の説明です.




02_TplFileList のプロパティ


以下のプロパティがあります,
ルートフォルダも展開表示するフォルダも実パス名でないと無効です.[戻る] 操作では,ルートフォルダより上の階層は表示できないようになっています.


凡例  published
 public
 ReadOnly

 RootFolder String ルートフォルダのフルパス名設定と取得
設定にデリミタの有無は問わないが取得の際にはデリミタ付き
この値を設定しないと何も表示しない
TplFolderTree の RootFolder で設定しても同じ
 ExpandFolder String リストするフォルダのフルパス名の設定と取得
設定にデリミタの有無は問わないが取得の際はデリミタ付き
TplFoldrerTree の SelectFolder で設定しても同じ
 DisplayExt Boolean 拡張子表示の有無
エクスプローラで,登録した拡張子を非表示にしていても拡張子を表示できる
 FindText String リスト表示する時のファイル名部分一致検索用文字列
ワイルドカード等は一切使用できない
空文字の時は,全てのファイル名をリスト表示する
フォルダ名に対しては無効なので注意
 FileInfo - 選択中のファイルの属性
Name       :  String    パス名を除いたファイル名(表示名)
Size       :  Integer   ファイルサイズ(バイト)
CreateDate : TDateTime  作成日
ModifyDate : TDateTime  更新日
IconIndex  : Integer    表示アイコンインデックス
Attrib     : Cardinal   属性
 CopyFilesList TStringList コピー対象のファイル名を格納するリスト
CopyFiles メソッド実行で,ここにファイル名が格納される
 FilesCount Integer 取得して表示したファイルの数




03_TplFileList のメソッド


以下のメソッドがあります.


BackFolder: Boolean;

エクスプローラの [Back] キーと同じ動作をするメソッドです.
TplFolderTree にも同じメソッドがありますが,どちらも同じ機能です.引数はありません.
RootFolder で設定したフォルダより上の階層には移動できません.


EditFileName: Boolean;

ファイル名の編集を開始するメソッドです.実行すると,ファイル名が編集可能となります.引数はありません.


CopyFiles: Boolean;

現在選択中のファイルを [コピー] する機能ですが,実際には,CopyFilesList (TStringList ) にファイル名を格納するだけです.クリップボードには格納しません.したがって,このメソッドを実行しても,選択中のファイルをエクスプローラには貼り付けできません.


PasteFiles: Boolean;

CopyFiles メソッドでコピーしたファイルを,表示内のフォルダ内に [貼付け] します.エクスプローラでコピーしたファイルは貼り付けできません.
TplFolderTree の CopyFolder メソッドの実行結果も貼付けできます.
フォルダを選択している場合は,そのフォルダ内に貼り付けするようにした方がいいかも知れません.


DeleteFile: Boolean;

選択中のファイルを削除します.


CreateFolder(AFolderName: String=''): Boolean;

現在の表示中のフォルダ内にフォルダを新規作成します.名前を指定しない場合は「新しいフォルダ」という名前になります.同じ名前のフォルダがある時は作成しません.
フォルダを選択している場合は,そのフォルダ内に作成するようにした方がいいかも知れません.
作成に成功すると True が,失敗すると False を返します.

引数 説明
AFolderName String 作成するフォルダの名前.空文字でもよい


RefreshView;

ファイル一覧を最新の情報に更新します.TplFolderTree を使用している時は,フォルダツリーの状態も更新します.


RefreshFilesListItems(ASort: Boolean=True);

RefrechView とは違い,ファイルリストだけを最新の状態に更新し,フォルダツリーは更新しません.
RefreshView メソッド内部で使用しているメソッドです.

引数 説明
ASort Boolean 更新の際にソートを行うかの指定


Execute:Boolean;

選択中のファイルを実行します.多くの場合はエクスプローラの [開く] 機能と同じです,これはダブルクリックまたは [Enter] キーでもこの Execute を実行するようになっています.


FileInfoDlg;

選択中のファイルの [プロパティ] ダイアログを表示します.




04_TplFileList のイベント


継承元のコンポーネントに,本コンポーネントで追加したイベントです.
TListView の OnChange はリスト内の項目の変更に対するイベントです.ファイルリストの更新等は検出できません.そのために以下のイベントを追加しています.参考までに,TTreeView の OnChange イベントは,選択ノードが変更となった時に発生するイベントです.


OnFolderChanging(Sender:TObject; var AFindText:String);

表示フォルダが変更する前に発生するイベントです.
引数の AFindText 文字列が含まれるファイル名だけをリスト表示しますが,フォルダ名に対しては無効です,この値をイベント内で使用しない場合は,FindText プロパティの文字列を含むファイル名だけをリスト表示します.

引数 説明
Sender TObject コンポーネント自身
AFindText String 部分一致検索用文字列


OnFolderChanged(Sender)

表示フォルダが変更となった直後に発生するイベントです.
表示を更新した時も発生します.また,TplFolderTree も使用している時は,ExpandFolder プロパティを設定した時と,選択フォルダを変更した時も発生します.

引数 説明
Sender TObject コンポーネント自身




05_フォルダツリー用コンポーネント TplFolderTree


指定フォルダ内のフォルダを階層的にツリー表示するコンポーネントです.
クラス名は TplFolderTree です.継承元は TCustomTreeView です.以下は,このコンポーネントのプロパティ,メソッド類の説明です.




06_TplFolderTree のプロパティ


以下のプロパティがあります,
ルートフォルダもツリー示するフォルダも実パス名が存在しない仮想フォルダ等は表示しません.


凡例  published
 public
 ReadOnly

 RootFolder String ルートフォルダ設定と取得
設定にデリミタの有無は問わないが取得の際はデリミタ付き
この値を設定しないと何も表示しない
TplFileList で RootFolder を設定しても同じ
 SelecteFolder String 選択フォルダの設定と取得
設定にデリミタの有無は問わないが取得の際はデリミタ付き
TplFileList の ExpandFolder と同じ値
 plFileList - ファイル一覧表示コンポーネントの指定
これを設定すると TplFileList と連携動作する
 CopyFilesList TStringList コピー対象のファイル名を格納するリスト
CopyFiles メソッド実行で,ここにファイル名が格納される




07_TplFolderTree のメソッド


以下のメソッドがあります.


BackFolder: Boolean;

エクスプローラの [Back] キーと同じ動作をするメソッドです.
TplFileList にも同じメソッドがありますが,どちらも同じ機能です.引数はありません.
RootFolder より上の階層には移動できません.


EditFolderName: Boolean;

フォルダ名の編集を開始するメソッドです.実行すると,フォルダ名が編集可能となります.引数はありません.


CopyFolder: Boolean;

現在選択中のフォルダを [コピー] する機能ですが,実際には,CopyFilesList (TStringList ) にフォルダ名を格納するだけです.クリップボードには格納しません.したがって,このメソッドを実行しても,選択中のフォルダをエクスプローラに貼り付けすることはできません.


PasteFolder: Boolean;

CopyFiles メソッドでコピーしたファイルを,選択中のフォルダ下に [貼付け] します.エクスプローラでコピーしたファイルは貼り付けできません.
TplFileList の CopyFolder メソッドの実行結果も貼付けできます.


DeleteFolder: Boolean;

選択中のフォルダを削除します.


CreateFolder(AFolderName: String=''): Boolean;

現在の選択中のフォルダ下にフォルダを新規作成します.名前を指定しない場合は「新しいフォルダ」という名前になります.同じ名前のフォルダがある時は作成しません.
作成に成功すると True が,失敗すると False を返します.

引数 説明
AFolderName String 作成するフォルダの名前.空文字でもよい


RefreshView(IsRoot: Boolean=False);

フォルダツリーの状態を最新の情報に更新します.TplFileList も使用している時は,選択中のフォルダ内のリストも更新します.
引数の値を True にすると,ルートフォルダ下の全てのツリー状態を更新し,False にすると選択中のフォルダの階層下だけを更新します.

引数 説明
IsRoot Boolean 更新するフォルダの階層の指定


FileInfoDlg;

選択中のフォルダの [プロパティ] ダイアログを表示します.




08_TplFolderTree のイベント


TCustomTreeView からの追加イベントはありません.




09_簡易エクスプローラとしてのテスト


作成したコンポーネントのテストプログラムです.
簡易エクスプローラとして利用できます.


  • 図1
  • テストプログラムの設計時画面

  • 図2
  • テストプログラムの実行開始画面
  • ルートフォルダは 'C:\' としている
  • ファイルを何も選択していない状態でポップアップメニューを表示しているところ

  • 図3
  • ファイルを選択してポップアップメニューを表示

リスト1
フォルダ一覧とファイル一覧用コンポーネントのテストプログラム
unit ExplorerTestUnit;

interface

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

type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    pnlBase: TPanel;
    plFolderTree1: TplFolderTree;
    Splitter1: TSplitter;
    plFileList1: TplFileList;
    btnRootFolder: TSpeedButton;
    btnBack: TSpeedButton;
    btnReName: TSpeedButton;
    btnCopy: TSpeedButton;
    btnPaste: TSpeedButton;
    btnDelete: TSpeedButton;
    btnNewFolder: TSpeedButton;
    btnRefresh: TSpeedButton;
    PopupMenu1: TPopupMenu;
    popup1Open: TMenuItem;
    popSeparator: TMenuItem;
    popup1Property: TMenuItem;
    PopupMenu2: TPopupMenu;
    popup2CreateFolder: TMenuItem;
    popSeparator1: TMenuItem;
    popup2CreateText: TMenuItem;
    popup2CreateWord: TMenuItem;
    popup2CreateExcel: TMenuItem;
    btnTest: TSpeedButton;
    pop1OpenProgram: TMenuItem;
    ApplicationEvents1: TApplicationEvents;
    procedure FormShow(Sender: TObject);
    procedure plFileList1Editing(Sender: TObject; Item: TListItem;
      var AllowEdit: Boolean);
    procedure plFileList1FolderChanging(Sender: TObject;
      var AFindText: String);
    procedure plFileList1FolderChanged(Sender: TObject);
    procedure plFolderTree1Change(Sender: TObject; Node: TTreeNode);
    procedure plFileList1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure plFileList1SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure plFileList1Click(Sender: TObject);
    procedure plFolderTree1Click(Sender: TObject);
    procedure btnRootFolderClick(Sender: TObject);
    procedure btnBackClick(Sender: TObject);
    procedure btnReNameClick(Sender: TObject);
    procedure btnCopyClick(Sender: TObject);
    procedure btnPasteClick(Sender: TObject);
    procedure btnNewFolderClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure btnRefreshClick(Sender: TObject);
    procedure popup1OpenClick(Sender: TObject);
    procedure popup1PropertyClick(Sender: TObject);
    procedure popup2CreateFolderClick(Sender: TObject);
    procedure popup2CreateTextClick(Sender: TObject);
    procedure popup2CreateWordClick(Sender: TObject);
    procedure popup2CreateExcelClick(Sender: TObject);
    procedure pop1OpenProgramClick(Sender: TObject);
    procedure ApplicationEvents1Activate(Sender: TObject);
  private
    { Private 宣言 }
    RootBasePath : String;
    ActiveMonitor : Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses FileCtrl,CommCtrl, StrUtils, ComObj, ShellAPI, plFileDialog;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//
//  フォーム表示開始時のルートフォルダを設定
//  必要であればここで各カラムの幅等を設定する
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);

  procedure SetBtnPosition(Btn: TSpeedButton; X: Integer; var btnRight: Integer);
  begin
    Btn.Flat := True;
    Btn.Top  := 3;
    Btn.Left := X;
    btnRight := X + Btn.Width;
  end;

var
  ALeft   : Integer;
  NewLeft : Integer;
begin
  //まだルートも設定していないのでフォルダの変更監視はしない
  ActiveMonitor := False;

  Self.Width   := 644;
  Self.Height  := 408;
  plFileList1.Column[0].Width := 180;
  plFolderTree1.Width         := 220;

  btnBack.Enabled      := False;
  btnReName.Enabled    := False;
  btnCopy.Enabled      := False;
  btnPaste.Enabled     := False;
  btnDelete.Enabled    := False;
  btnNewFolder.Enabled := False;
  btnRefresh.Enabled   := False;

  //ボタン類の位置を再設定
  ALeft := 4;
  SetBtnPosition(btnRootFolder, ALeft,     NewLeft);
  SetBtnPosition(btnBack,       NewLeft,   ALeft);
  SetBtnPosition(btnReName,     ALeft,     NewLeft);
  SetBtnPosition(btnCopy,       NewLeft,   ALeft);
  SetBtnPosition(btnPaste,      ALeft,     NewLeft);
  SetBtnPosition(btnDelete,     NewLeft,   ALeft);
  SetBtnPosition(btnNewFolder,  ALeft + 5, NewLeft);
  SetBtnPosition(btnRefresh,    NewLeft,   ALeft);
  SetBtnPosition(btnTest,       ALeft,     NewLeft);

  //ルートフォルダを指定しなければ何も表示しない
  RootBasePath := 'C:\';
  plFolderTree1.RootFolder := RootBasePath;
end;

//=============================================================================
//  ルートフォルダの指定
//  拙作のTplBrowseFolderコンポーネントを使用
//
//  ルートフォルダはTplFileList,TplFolderTreeのどちらで指定しても同じ
//  TplFileList,TplFolderTree共に仮想フォルダは指定できない
//  また[マイドキュメント]は[MyDocument]になる
//=============================================================================
procedure TForm1.btnRootFolderClick(Sender: TObject);
var
  BrowseFolder : TplBrowseFolder;
  Options      : TplBrowseOptions;
begin
  BrowseFolder := TplBrowseFolder.Create(Self);
  try
    Options := [];
    Include(Options, bifNoNewFolderButton);
    Include(Options, bifReturnOnlyFSDirs);
    BrowseFolder.Options := Options;

    BrowseFolder.FormTop  := Self.Top  + 50;
    BrowseFolder.FormLeft := Self.Left + 50;

    BrowseFolder.InitDir := RootBasePath;
    if BrowseFolder.Execute then begin
      RootBasePath := BrowseFolder.Directory;
      plFileList1.RootFolder := RootBasePath;
    end;
  finally
    FreeAndNil(BrowseFolder);
  end;
end;

//=============================================================================
//  1つ上の階層のフォルダを選択
//  TplFileList,TplFolderTreeのどちらのBackFolderを実行しても同じ
//=============================================================================
procedure TForm1.btnBackClick(Sender: TObject);
begin
  if plFileList1.Focused then begin
    plFileList1.BackFolder;
  end else
  if plFolderTree1.Focused then begin
    plFolderTree1.BackFolder;
  end;
end;

//=============================================================================
//  名前の編集
//=============================================================================
procedure TForm1.btnReNameClick(Sender: TObject);
begin
  if plFileList1.Focused then begin
    plFileList1.EditFileName;
  end else
  if plFolderTree1.Focused then begin
    plFolderTree1.EditFolderName;
  end;
end;

//=============================================================================
//  コピー
//  TplFolderTreeにフォーカスがあれば選択ノードのフォルダをコピー
//  TplFileListにフォーカスがあれば選択フォルダまたはファイルをコピー
//  (TplFileListでは複数指定可能)
//=============================================================================
procedure TForm1.btnCopyClick(Sender: TObject);
begin
  if plFileList1.Focused then begin
    plFileList1.CopyFiles;
  end else
  if plFolderTree1.Focused then begin
    plFolderTree1.CopyFolder;
  end;

  btnPaste.Enabled := True;
end;

//=============================================================================
//  貼付け
//  TplFolderTreeにフォーカスがあれば選択ノードのフォルダ内に貼付け
//  TplFileListにフォーカスがあれば表示中のフォルダ内に貼付け
//  TplFileListの場合,選択フォルダ内への貼り付けいの方がいいかも知れない
//=============================================================================
procedure TForm1.btnPasteClick(Sender: TObject);
begin
  if plFileList1.Focused then begin
    plFileList1.PasteFiles;
  end else
  if plFolderTree1.Focused then begin
    plFolderTree1.PasteFolder;
  end;
end;

//=============================================================================
//  フォルダまたはファイルの削除
//  TplFolderTreeにフォーカスがあれば選択ノードのフォルダを削除
//  TplFileListにフォーカスがあれば選択フォルダまたはファイルを削除
//
//  削除は[Delete]キーでも可能なので,btnDeleteの使用可否をこのイベントだけで
//  完全に決定するのは困難.OnKeyDownも処理する必要あり
//=============================================================================
procedure TForm1.btnDeleteClick(Sender: TObject);
begin
  if plFileList1.Focused then begin
    plFileList1.DeleteFiles;
  end else
  if plFolderTree1.Focused then begin
    plFolderTree1.DeleteFolder;
  end;

  plFolderTree1.SetFocus;
  btnRename.Enabled := (plFileList1.SelCount = 1);
  btnCopy.Enabled   := (plFolderTree1.SelectFolder <> plFolderTree1.RootFolder);
end;

//=============================================================================
//  フォルダの新規作成
//  TplFolderTreeにフォーカスがあれば選択ノードのフォルダ内に作成
//  TplFileListにフォーカスがあれば表示フォルダ内に作成
//=============================================================================
procedure TForm1.btnNewFolderClick(Sender: TObject);
begin
  if plFileList1.Focused   then begin
    plFileList1.CreateFolder;
  end else
  if plFolderTree1.Focused then begin
    plFolderTree1.CreateFolder;
  end;
end;

//=============================================================================
//  最新の情報に更新
//  ここではルートフォルダとしている
//
//  ルートフォルダ(つまり全ツリー状態)を監視すると更新に時間がかかるが,特定の
//  フォルダを監視する価値はあるかも知れない
//=============================================================================
procedure TForm1.btnRefreshClick(Sender: TObject);
begin
  //TplFolderTreeのRefrechViewの引数がTrueの時はルートフォルダ以下の更新
  //引数の指定がない場合は選択中のフォルダ以下のみの更新
  plFolderTree1.RefreshView(True);
end;

//=============================================================================
//  名前編集開始前のイベント
//  日本語を入力を可能にする
//=============================================================================
procedure TForm1.plFileList1Editing(Sender: TObject; Item: TListItem;
  var AllowEdit: Boolean);
begin
  SetImeMode(plFileList1.Handle,imHira);

  btnReName.Enabled    := False;
  btnCopy.Enabled      := False;
  btnDelete.Enabled    := False;
  btnNewFolder.Enabled := False;
  btnRefresh.Enabled   := False;
end;

//=============================================================================
//  Itemが選択されたらStatusBar1にファイル名を表示
//=============================================================================
procedure TForm1.plFileList1SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  //ファイルが1つだけ選択されている時だけ表示
  if plFileList1.SelCount = 1 then begin
    StatusBar1.Panels[1].Text := ' ' +
               IncludeTrailingPathDelimiter(plFileList1.ExpandFolder) +
               plFileList1.FileInfo.Name;
  end else begin
    StatusBar1.Panels[1].Text := '';
  end;
end;

//=============================================================================
//  TplFileListコンポーネントをクリックした時のイベント
//  名前の編集中でなければIMEを閉じる
//  現実には[Enter]の場合も検出してIMEを閉じる必要があるだろう
//  OnEditedは実際に変更がないと検出できないのでここで検出
//=============================================================================
procedure TForm1.plFileList1Click(Sender: TObject);
var
  EditorHandle : HWND;
  Flag         : Boolean;
begin
  //ListViewのインプレースエディタのハンドルを取得
  //編集中であれば0を越える値(>0)となる
  EditorHandle := ListView_GetEditControl(plFileList1.Handle);
  if EditorHandle = 0 then begin
    SetImeMode(plFileList1.Handle, imDisable);
  end;

  Flag := (plFileList1.SelCount > 0) and (EditorHandle = 0);

  btnReName.Enabled    := Flag;
  btnCopy.Enabled      := Flag;
  btnDelete.Enabled    := Flag;
  btnNewFolder.Enabled := True;
  btnRefresh.Enabled   := True;
end;

//=============================================================================
//  TplFolderTreeコンポーネントをクリックした時のイベント
//  各操作用ボタンの使用可否を設定
//=============================================================================
procedure TForm1.plFolderTree1Click(Sender: TObject);
var
  EditorHandle : HWND;
  Flag         : Boolean;
begin
  //TreeViewのインプレースエディタのハンドルを取得
  //編集中であれば0を越える値(>0)となる
  EditorHandle := TreeView_GetEditControl(plFolderTree1.Handle);
  if EditorHandle = 0 then begin
    SetImeMode(plFolderTree1.Handle, imDisable);
  end;

  Flag := (plFolderTree1.SelectionCount = 1) and
          (plFolderTree1.SelectFolder <> plFolderTree1.RootFolder) and
          (EditorHandle = 0);

  btnReName.Enabled    := Flag;
  btnCopy.Enabled      := Flag;
  btnDelete.Enabled    := Flag;
  btnNewFolder.Enabled := True;
  btnRefresh.Enabled   := True;

  StatusBar1.Panels[1].Text := '';
end;

//=============================================================================
//  TplFileListで表示フォルダが変更となる前のイベント
//  TListViewにはない,TplFileListで追加したイベント
//  FindTextプロパティを空白にしておかないと前の表示条件を引き継いでしまう
//  ただしこのユニットでは,どこにもFindTextは定義していない
//  引数のAFindTextがFindTextプロパティの値
//=============================================================================
procedure TForm1.plFileList1FolderChanging(Sender: TObject; var AFindText: String);
begin
  AFindText := '';
end;

//=============================================================================
//  TplFileListで表示フォルダが変更となった時のイベント
//  TListViewにはない,TplFileListで追加したイベント
//  このイベントは[最新の情報に更新]した時も発生する
//=============================================================================
procedure TForm1.plFileList1FolderChanged(Sender: TObject);
var
  StrText : String;
begin
  //ファイル数を表示
  StrText := IntToStr(plFileList1.FilesCount);
  StatusBar1.Panels[0].Text := ' ファイル数 : ' + StrText + ' 個';
  StatusBar1.Panels[1].Text := '';
end;

//=============================================================================
//  TplFolderTreeで選択フォルダが変更となった時のイベント
//  各ボタン類の使用可否を設定
//=============================================================================
procedure TForm1.plFolderTree1Change(Sender: TObject; Node: TTreeNode);
var
  Flag : Boolean;
begin
  Flag := plFolderTree1.SelectFolder <> plFolderTree1.RootFolder;
  btnReName.Enabled    := Flag;
  btnBack.Enabled      := Flag;
  btnCopy.Enabled      := Flag;
  btnNewFolder.Enabled := (plFolderTree1.Selected <> nil);
  btnDelete.Enabled    := Flag;
  btnRefresh.Enabled   := (plFolderTree1.Selected <> nil);
end;

//=============================================================================
//  plFileListのマウスクリックイベント
//  ポップアップメニューを表示する
//  TCustomListViewにはMouseUpはないのでMouseDownを使用
//=============================================================================
procedure TForm1.plFileList1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  APos : TPoint;
begin
  if Button=mbRight then begin
    plFileList1Click(nil);

    //マウスの座標値をplFileList1の座標値に変換
    APos   := plFileList1.ClientToScreen(Point(X, Y));
    if plFileList1.Selected = nil then begin
      PopupMenu2.Popup(APos.X, APos.Y);
    end else
    if plFileList1.SelCount = 1 then begin
      PopupMenu1.Popup(APos.X, APos.Y);
    end;
  end;
end;

//=============================================================================
//  ポップアップメニューの[開く]
//=============================================================================
procedure TForm1.popup1OpenClick(Sender: TObject);
begin
  plFileList1.Execute;
end;

//=============================================================================
//  ポップアップメニューの[プログラムから開く]
//  ここではコマンrundll32.exeを利用して実行
//  ただし,どんなファイルでもこのダイアログが表示されるわけではない
//=============================================================================
procedure TForm1.pop1OpenProgramClick(Sender: TObject);
var
  FullPath : String;
  SendPath : String;
begin
  FullPath := plFileList1.ExpandFolder + plFileList1.Selected.Caption;
  SendPath := 'shell32.dll,OpenAs_RunDLL ' + FullPath;

  ShellExecute(0, nil, 'rundll32.exe', PChar(SendPath), PChar(SendPath), 0);
end;

//=============================================================================
//  ポップアップメニューの[プロパティ]
//  ファイルのプロパティのダイアログを表示
//  ダイアログから戻るとOnActivateイベントが発生して表示が更新される.ただし更
//  新されのはその時の選択中のフォルダ内だけなので注意
//=============================================================================
procedure TForm1.popup1PropertyClick(Sender: TObject);
begin
  plFileList1.FileInfoDlg;
end;

//=============================================================================
//  ポップアップメニューの[フォルダの新規作成]
//=============================================================================
procedure TForm1.popup2CreateFolderClick(Sender: TObject);
begin
  plFileList1.CreateFolder();
end;

//=============================================================================
//  ポップアップメニューの[テキスト ドキュメント作成]
//  シェルインターフェイスもレジストリも使用しない方法の一つ
//=============================================================================
procedure TForm1.popup2CreateTextClick(Sender: TObject);
var
  i            : Integer;
  BaseFileName : String;
  SaveFileName : String;
  FileHandle   : Integer;
begin
  BaseFileName := '新規テキスト ドキュメント';
  SaveFileName := BaseFileName+'.txt';

  //まず既に同じ名前がないか調査し,あれば後ろに(1),(2),(3),...を付加
  i := 1;
  while True do begin
    if not FileExists(plFileList1.ExpandFolder + SaveFileName) then begin
      break;
    end;
    i := i + 1;
    SaveFileName := BaseFileName+' (' + IntToStr(i) + ').txt';
  end;

  //指定の名前でテキストファイル作成
  FileHandle := 0;
  try
    FileHandle := FileCreate(plFileList1.ExpandFolder + SaveFileName);
  finally
    if FileHandle <> 0 then FileClose(FileHandle);
  end;

  //[最新の情報に更新]し,一番下にあるハズなのでそれを編集モードにする
  plFileList1.RefreshFilesListItems(False);
  plFileList1.Items[plFileList1.FilesCount - 1].EditCaption;
end;

//=============================================================================
//  ポップアップメニューの[ワード文書作成]
//  シェルインターフェイスもレジストリも使用しない方法の一つ
//  CreateOleObjectにはussesにComObjが必要
//=============================================================================
procedure TForm1.popup2CreateWordClick(Sender: TObject);
var
  i            : Integer;
  BaseFileName : String;
  SaveFileName : String;
  WordObj      : Variant;
  WordDocu     : Variant;
begin
  BaseFileName := '新規ワード文書';
  SaveFileName := BaseFileName+'.doc';

  //まず既に同じ名前がないか調査し,あれば後ろに(1),(2),(3),...を付加
  i := 1;
  while True do begin
    if not FileExists(plFileList1.ExpandFolder + SaveFileName) then begin
      break;
    end;
    i := i + 1;
    SaveFileName := BaseFileName+' (' + IntToStr(i) + ').doc';
  end;

  //ワードのオブジェクトを作成
  //保存したら閉じる
  WordObj := CreateOleObject('Word.Application');
  WordObj.DisplayAlerts := False;
  try
    //文書(ドキュメント)を作成して保存
    WordDocu := WordObj.Documents.Add;
    WordObj.Selection.Font.Size := 20;
    WordObj.Selection.Font.Name := 'MS Pゴシック';
    WordObj.Selection.TypeText('こんにちは,Mr.XRAYです.');
    WordDocu.Saved := True;
    WordDocu.SaveAs(plFileList1.ExpandFolder + SaveFileName);
  finally
    //保存したらワードのを終了させる
    WordDocu.Close;
    WordDocu := unAssigned;
    WordObj.Quit;
    WordObj := unAssigned;
  end;

  //[最新の情報に更新]し,一番下にあるハズなのでそれを編集モードにする
  plFileList1.RefreshFilesListItems(False);
  plFileList1.Items[plFileList1.FilesCount - 1].EditCaption;
end;

//=============================================================================
//  ポップアップメニューの[エクセルブック作成]
//  シェルインターフェイスもレジストリも使用しない方法の一つ
//  CreateOleObjectにはussesにComObjが必要
//=============================================================================
procedure TForm1.popup2CreateExcelClick(Sender: TObject);
var
  i            : Integer;
  BaseFileName : String;
  SaveFileName : String;
  ExcelObj     : Variant;
  WorkBook     : Variant;
  WorkSheet    : Variant;
begin
  BaseFileName := '新規エクセルブック';
  SaveFileName := BaseFileName+'.xls';

  //まず既に同じ名前がないか調査し,あれば後ろに(1),(2),(3),...を付加
  i := 1;
  while True do begin
    if not FileExists(plFileList1.ExpandFolder + SaveFileName) then begin
      break;
    end;
    i := i + 1;
    SaveFileName := BaseFileName+' ('+IntToStr(i) + ').xls';
  end;

  //Excelのオブジェクトを作成
  ExcelObj := CreateOleObject('Excel.Application');
  try
    //ブックとシートオブジェクトを作成して保存
    WorkBook  := ExcelObj.Workbooks.Add;
    WorkSheet := WorkBook.WorkSheets[1];
    WorkSheet.Cells[1,1].Value := 'Mr.XRAY';
    WorkBook.SaveAs(plFileList1.ExpandFolder+SaveFileName);
  finally
    //保存したらExcelを終了させる
    WorkSheet :=unAssigned;
    WorkBook  :=unAssigned;
    ExcelObj.Quit;
    ExcelObj  :=unAssigned;
  end;

  //[最新の情報に更新]し,一番下にあるハズなのでそれを編集モードにする
  plFileList1.RefreshFilesListItems(False);
  plFileList1.Items[plFileList1.FilesCount - 1].EditCaption;
end;

//=============================================================================
//  このアプリがアクティブ(他のウィンドウからフォーカス移動)したら選択フォルダ
//  内のみを[最新の情報に更新]する
//=============================================================================
procedure TForm1.ApplicationEvents1Activate(Sender: TObject);
begin
  if ActiveMonitor then begin
    plFileList1.RefreshView;
  end else begin
    ActiveMonitor := True;
  end;
end;

end.




10_ファイルの属性の確認


上のようなプログラム (アプリケーション) は,フォルダのツリー表示,あるいは,ファイルの一覧表示だけが目的とは言えません.
多くの場合,何かの目的でフォルダツリーやファイルのリストを取得します.ファイルを何かのアプリで表示したりするのもその目的の 1 つです.その際に,対象のファイルがシステムファイルか等の情報が必要となることがあります.その参考用のサンプルです.



図4
設計時画面
  • TplFileList コンポを配置
図5
ファイルの属性を表示


リスト2
ファイルの属性の確認
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    plFileList1: TplFileList;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure plFileList1SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    SelectDir : String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses AttribUnit, ShellAPI;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Button2.Enabled := False;
end;

//=============================================================================
//  表示するフォルダの選択
//  拙作のTplBrowseFolderコンポーネントを使用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  BrowseFolder : TplBrowseFolder;
begin
  BrowseFolder := TplBrowseFolder.Create(Self);
  try
    BrowseFolder.Options  := [bifReturnOnlyFSDirs];
    BrowseFolder.FormTop  := Self.Top  + 50;
    BrowseFolder.FormLeft := Self.Left + 50;

    if SelectDir = '' then begin
      BrowseFolder.InitDir := ExtractFileDir(Application.ExeName);
    end else begin
      BrowseFolder.InitDir := SelectDir;
    end;

    if BrowseFolder.Execute then begin
      SelectDir := BrowseFolder.Directory;
      plFileList1.RootFolder := SelectDir;
    end;
  finally
    FreeAndNil(BrowseFolder);
  end;
end;

//=============================================================================
//  ファイルの属性を取得して表示
//  SHGetFileInfo関数による値とplFileList1.FileInfo.Attribで取得した値を表示
//
//  [備考]
//  ファイルの属性の取得には,IShellFolderインターフェイスのGetAttributesOf
//  メソッドを使用する方法もある
//  SHGetFileInfoで取得する値とGetAttributesOfで取得する値が異なるのは,コント
//  ロールパネル内のファイル等,特殊フォルダ内の一部だけ
//  通常のファイルでは違いはない
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  FileName   : String;
  FullPath   : String;
  SHFileInfo : TSHFileInfo;
  AttribForm : TAttribForm;
begin
  FileName := plFileList1.FileInfo.Name;
  FullPath := IncludeTrailingPathDelimiter(SelectDir) + FileName;

  FillChar(SHFileInfo, SizeOf(TSHFileInfo), #0);
  if SHGetFileInfo(PChar(FullPath),
                   0,
                   SHFileInfo,
                   SizeOf(SHFileInfo),
                   SHGFI_ATTRIBUTES) = 0 then begin
    exit;
  end;


  AttribForm := TAttribForm.Create(Self);
  try
    AttribForm.Panel1.Caption := FileName;
    AttribForm.Attrib         := SHFileInfo.dwAttributes;
    AttribForm.FileAttrib     := plFileList1.FileInfo.Attrib;
    AttribForm.ShowModal;
  finally
    FreeAndNil(AttribForm);
  end;
end;

//=============================================================================
//  plFileList1のOnSelectItemイベント処理
//  選択ファイルが1つだけの時だけ[属性]ボタンを使用可能にする
//=============================================================================
procedure TForm1.plFileList1SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  if plFileList1.SelCount > 1 then exit;
  Button2.Enabled := Selected;
end;

end.




11_項目識別子による操作との違い


今回作成したコンポーネントでは,下図のような GUID で表わされる仮想フォルダは表示できません.
下図は,シェルネームスペースの機能を使用して,項目識別子で,Windows 7 で実装された仮想フォルダ [ライブラリ] を表示した例です.
また,表示可能なフォルダの表示名も,例えば [マイドキュメント] は [MyDocument] になります.



図6
[ライブラリ]
  • この図は項目識別子によるもの




12_Windows の ZIP 展開機能とファイルのダブルクリック 操作


Windows の ZIP 展開機能も本コンポーネントでは扱えません.
Windows XP では,CAB や ZIP の展開機能が追加されました.この機能を有効にしていると,エクスプローラではこのファイルを展開して表示できます.項目識別子では,シェルの機能を使用しますから,同様に展開が可能です.下図は,plFileDialog.zip を展開表示した例です.

項目識別子を使用した場合,本ページで使用したコンポーネントと同じように,拡張子の関連付けのアプリケーションで [開く] には,ZIP ファイル等を展開する前に,関連付けアプリケーションの存在をチェックします.



[備考]
Windows の ZIP ファイル展開機能は,Windows XP であれば次のように制御できます.ただし,この操作を行うと,圧縮解凍アプリの拡張子関連付けが無効となってしまうことがあるようです.

  • zip ファイル検索を有効にするには,コマンドラインから regsvr32 zipfldr.dll を実行
  • zip ファイル検索を無効にするには,コマンドラインで regsvr32 /u zipfldr.dll を実行
  • 参考までに,cab ファイルの場合は regsvr32 cabview.dll と regsvr32 /u cabview.dll
Windows Visate 以降では,上の操作では制御できません.Windows Vista ではレジストリを操作すれば可能なようですが,筆者は確認していません.また,Windows 7 での方法は未調査です.




図7
ZIP ファイルの展開
  • この図は項目識別子によるもの




13_エクスプローラ間のコピーと貼り付け操作


今回作成したコンポーネントには,[コピー] [貼り付け] 機能が実装されていますが,これらは,コンポーネントを使用したアプリケーション内だけで有効となっています.
エクスプローラとの間でのコピーや貼り付けはできません.

これらの簡易エクスプローラ作成用のコンポーネント類は,元々,筆者が開発する業務アプリケーションで使用するために開発したものです.利用対象のユーザは,パワーユーザでも開発者でもありません.それらのユーザは,システム関係のフォルダを操作することはありません.ユーザが操作するのは個人に割り当てられたフォルダと,共有フォルダだけです.
そのようなエンドユーザが,エクスプローラーの間で [コピー] や [貼り付け] が出来てしまうと,「何もしていないのに」事件が多発することなります,
このトラブルを防止するために,そのような仕様としています.

他のアプリケーションやエクスプローラとの間で [コピー] [貼り付け] の機能を実装するには,いくつかの方法があります.
1 つは本コンポーネントでも使用している SHFileOperation 関数を使用する方法です.また,次の項目のように,拙作のコンテキストメニューコンポーネントも使用可能です.






14_コンテキストメニュー


本ページの最初の,簡易エクスプローラのサンプルでは,マウスの右ボタンクリックでポップアップメニューを表示して各種の操作を可能にしています.
これを,エクスプローラのようなコンテキストメニューを表示して操作するためのコンポーネントを当サイトで提供しています.これを利用したサンプルです.

当初は,ヒシアマゾンさん作の TContextMenuEx コンポーネントを使用していましたが,このコンポーネントは現在入手できません.また,Delphi 2009 以降では使用できません.そこで同様の機能を持つコンポーネントを新たに開発しました.
このコンテキストメニューコンポーネントでは,メニューを表示しなくても,[コピー] [貼り付け]を実行するコマンドを実装しています.以下のサンプルは,これらのコマンドを使用しています.
フォルダツリー部とファイルリスト部とで,別のサンプルにしていますが,簡易エクスプローラのようなアプリでは別々に使用する必要はありません.






15_TplFolderTree でのコンテキストメニューの使用


フォルダツリーコンポーネント TplFolderTree での使用例です.
コンテキストメニューでも操作できますが,[コピー] [貼り付け] のコマンドを実行するボタンも配置しています.


図8
設計時画面
図9
実行時画面1
  • マウス右ボタンクリックでコンテキストメニュー表示

図10
エクスプローラから貼り付け
  • エクスプローラで [AAA] をコピーし,このテストプログラムの [DDD] を選択して貼り付けた例

リスト3
他のアプリケーション間とのコピーと貼り付けの機能を実装
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ApplicationEvents1: TApplicationEvents;
    Panel1: TPanel;
    Panel2: TPanel;
    plFolderTree1: TplFolderTree;
    Button1: TButton;
    Button2: TButton;
    plContextMenu1: TplContextMenu;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure plFolderTree1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ApplicationEvents1Activate(Sender: TObject);
    procedure plFolderTree1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses Clipbrd;

{$R *.dfm}

//=============================================================================
//  Form表示開始時の処理
//  [貼り付け][コピー]のボタンを使用不可に
//  ルートフォルダはこのプロジェクトのフォルダとする
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  Button1.Enabled := False;
  Button2.Enabled := False;

  plFolderTree1.RootFolder := ExtractFilePath(Application.ExeName);
end;

//=============================================================================
//  クリップボードから貼り付け
//  エクスプローラで[コピー]実行したファイルを貼り付ける
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  //関数が成功したら選択中のフォルダのみ表示更新(RefreshViewの引数がFalse)
  //Paste作業が完全に終了しないとRefreshViewが正常動作しないのでタイムラグ
  //このタイムラグはファイル数にも影響するかも知れない

  plContextMenu1.Files.Clear;
  plContextMenu1.Directory := plFolderTree1.SelectFolder;

  if plContextMenu1.InvokeCommand(IDCMDSTR_PASTE) then begin
    Sleep(200);
    plFolderTree1.RefreshView(False);
    plFolderTree1.SetFocus;
  end;
end;

//=============================================================================
//  クリップボードへのコピー
//  これを実行後に,エクスプローラに[貼り付け]が可能となる
//
//  TplFolderTreeの仕様として,ルートフォルダは選択中でも選択として認識しないの
//  注意.つまりルートフォルダはコピーできない
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  plContextMenu1.Files.Clear;
  plContextMenu1.Directory := plFolderTree1.SelectFolder;

  if plContextMenu1.InvokeCommand(IDCMDSTR_COPY) then begin
    plFolderTree1.SetFocus;
  end;
end;

//=============================================================================
//  マウスの右ボタンクリックでコンテキストメニュー表示
//  TplFolderTreeの仕様として,選択しないとMouseDownが発生しないので注意
//=============================================================================
procedure TForm1.plFolderTree1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  APoint : TPoint;
begin
  if Button = mbRight then begin
    plContextMenu1.Files.Clear;
    plContextMenu1.Directory := plFolderTree1.SelectFolder;

    //関数が成功したら何か操作した可能性があるので表示更新
    //Paste作業が完全に終了しないとRefreshViewが正常動作しないのでタイムラグ
    //このタイムラグはファイル数にも影響するかも知れない
    GetCursorPos(APoint);
    plContextMenu1.Popup(APoint.X, APoint.Y);
    Sleep(200);
    plFolderTree1.RefreshView(False);
  end;
end;

//=============================================================================
//  このFormがアクティブになった時の処理
//  クリップボードにエクスプローラの[コピー]操作があれば[貼り付け]ボタンを使用
//  可能にする
//  選択中のフォルダがルートでなければ[コピー]を使用可能に
//=============================================================================
procedure TForm1.ApplicationEvents1Activate(Sender: TObject);
begin
  if Clipboard.HasFormat(CF_HDROP) then begin
    Button1.Enabled := plFolderTree1.SelectionCount > 0;
  end;

  Button2.Enabled := plFolderTree1.SelectFolder <> plFolderTree1.RootFolder;
  //変更があったかも知れないのでルート以下を[最新の情報に更新]
  plFolderTree1.RefreshView(True);
end;

//=============================================================================
//  フォルダツリー部をクリックした時の処理
//  コピーと貼り付け動作が可能かのチェックをApplicationEvent1Activateで行う
//=============================================================================
procedure TForm1.plFolderTree1Click(Sender: TObject);
begin
  ApplicationEvents1Activate(nil);
end;

end.




16_TplFileList でのコンテキストメニューの使用


ファイル一覧コンポーネント TplFileList での使用例です.
コンテキストメニューでも操作できますが,[コピー] [貼り付け] のコマンドを実行するボタンも配置しています.操作後に RefreshView を実行していますが,実際にはエクスプローラ側での更新がないと反映されません.


図11
設計時画面
図12
実行時画面1
  • マウスの右ボタンでコンテキストメニューを表示
図13
エクスプローラから貼り付け
  • エクスプローラで [AAA] 内のファイルをコピーして,[貼り付け] ボタンをクリックした例

リスト4
他のアプリケーション間とのコピーと貼り付けの機能を実装
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ApplicationEvents1: TApplicationEvents;
    Panel1: TPanel;
    Panel2: TPanel;
    Button1: TButton;
    Button2: TButton;
    plFileList1: TplFileList;
    plContextMenu1: TplContextMenu;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure plFileList1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ApplicationEvents1Activate(Sender: TObject);
    procedure plFileList1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses Clipbrd;

{$R *.dfm}

//=============================================================================
//  Form表示開始時の処理
//  [貼り付け][コピー]のボタンを使用不可に
//  ルートフォルダはこのプロジェクトのフォルダ直下の[TestFiles]とする
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  Button1.Enabled := False;
  Button2.Enabled := False;

  plFileList1.Column[0].Width := 110;
  plFileList1.RootFolder   := ExtractFilePath(Application.ExeName) + 'TestFiles';
  plFileList1.ExpandFolder := ExtractFilePath(Application.ExeName) + 'TestFiles';
end;

//=============================================================================
//  クリップボードから貼り付け
//  エクスプローラで[コピー]を実行したファイルを貼り付ける
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  //関数が成功したら選択中のフォルダのみ表示更新(RefreshViewの引数がFalse)
  //Paste作業が完全に終了しないとRefreshViewが正常動作しないのでタイムラグ
  //このタイムラグはファイル数にも影響するかも知れない
  plContextMenu1.Files.Clear;
  plContextMenu1.Directory := plFileList1.ExpandFolder;

  if plContextMenu1.InvokeCommand(IDCMDSTR_PASTE) then begin
    plFileList1.RefreshView;
  end;
  plFileList1.SetFocus;
end;

//=============================================================================
//  現在選択中のファイルをクリップボードへのコピー
//  これを実行後に,エクスプローラに[貼り付け]が可能となる
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  i : Integer;
begin
  plContextMenu1.Files.Clear;
  plContextMenu1.Directory := plFileList1.ExpandFolder;

  for i := 0 to plFileList1.CopyFilesList.Count - 1 do begin
    plContextMenu1.Files.Add(ExtractFileName(plFileList1.CopyFilesList[i]));
  end;
  plContextMenu1.InvokeCommand(IDCMDSTR_COPY);
  plFileList1.SetFocus;
end;

//=============================================================================
//  マウスの右ボタンクリックでコンテキストメニュー表示
//  このコードは,ファイルを選択していない状態でコンテキストメニューを表示した
//  場合は,表示中のフォルダが操作対象となるようにしている
//=============================================================================
procedure TForm1.plFileList1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  SL     : TStringList;
  i      : Integer;
  APoint : TPoint;
begin
  if Button=mbRight then begin
    SL := TStringList.Create;
    try
      plContextMenu1.Files.Clear;
      plContextMenu1.Directory := plFileList1.ExpandFolder;

      SL.Assign(plFileList1.CopyFilesList);
      for i := 0 to SL.Count - 1 do begin
        plContextMenu1.Files.Add(ExtractFileName(SL[i]));
      end;

      //実行したら更新があるかも知れないのでフォルダ内を表示更新
      //Paste作業が完全に終了しないとRefreshViewが正常動作しないのでタイムラグ
      //このタイムラグはファイル数にも影響するかも知れない
      GetCursorPos(APoint);
      plContextMenu1.Popup(APoint.X, APoint.Y);
      Sleep(200);
      plFileList1.RefreshView;
    finally
      FreeAndNil(SL);
    end;
    plFileList1.SetFocus;
  end;
end;

//=============================================================================
//  このFormがアクティブになった時の処理
//  クリップボードにエクスプローラの[コピー]操作があれば[貼り付け]ボタンを使用
//  可能にする
//=============================================================================
procedure TForm1.ApplicationEvents1Activate(Sender: TObject);
begin
  if Clipboard.HasFormat(CF_HDROP) then begin
    Button1.Enabled := True;
  end;

  Button2.Enabled := plFileList1.SelCount > 0;
  //変更があったかも知れないのでフォルダ内を[最新の情報に更新]
  plFileList1.RefreshView;
end;

//=============================================================================
//  ファイルリスト部をクリックした時の処理
//  コピーと貼り付け動作が可能かのチェックをApplicationEvent1Activateで行う
//=============================================================================
procedure TForm1.plFileList1Click(Sender: TObject);
begin
  ApplicationEvents1Activate(nil);
end;

end.




17_[ ファイルを開くプログラムの選択 ] ダイアログの表示


選択したファイルに対して,[ファイルを開くプログラムの選択]ダイアログを表示するサンプルです.
このコードはフォルダの時もダイアログを表示します.必要に応じて判断するコードが必要です.



図14
設計時画面
図15
EXE 実行開始画面
  • 指定フォルダ内のファイルを表示
図16
[ダイアログ表示 1] クリック
図17
[ダイアログ表示 2] クリック

リスト5
[ファイルを開くプログラムの選択] ダイアログを表示
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Button1: TButton;
    Button2: TButton;
    plFileList1: TplFileList;
    ApplicationEvents1: TApplicationEvents;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ApplicationEvents1Activate(Sender: TObject);
    procedure plFileList1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ShellAPI;

{$R *.dfm}

//=============================================================================
//  Form表示開始時の処理
//  ルートフォルダはこのプロジェクトのフォルダ直下の[TestFiles]として,この直下
//  のフォルダ[AAA]をリストする
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  ARootFolder : String;
begin
  Button1.Enabled := False;
  Button2.Enabled := False;

  ARootFolder := ExtractFilePath(Application.ExeName) + 'TestFiles';
  plFileList1.Column[0].Width := 110;
  plFileList1.RootFolder   := ARootFolder;
  plFileList1.ExpandFolder := ARootFolder+'\AAA';
end;

//=============================================================================
//  [ファイルを開くプログラムの選択]ダイアログを表示
//  複数選択されている場合は最初のものだけが対象
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AFullPath : String;
begin
  AFullPath := plFileList1.ExpandFolder+plFileList1.Selected.Caption;
  ShellExecute(0,
               nil,
               PChar('rundll32.exe'),
               PChar('shell32.dll, OpenAs_RunDLL ' + AFullPath),
               nil,
               0);
end;

//=============================================================================
//  [ファイルを開くプログラムの選択]ダイアログを表示
//  複数選択されている場合は最初のものだけが対象
//  AFullPathの後に空白を付加して
//  [この種類のファイルを開くときは,選択したプログラムをいつも使う]
//  [使用るすプログラムが一覧やコンピュータにない場合は,...Web...]
//  を使用不可としている.ただし,表示されるアプリのリストは分類されない
//  ユーザに変更されたくない場合等にいいかも知れない
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  AFullPath : String;
begin
  AFullPath := plFileList1.ExpandFolder+plFileList1.Selected.Caption;
  ShellExecute(0,
               nil,
               PChar('rundll32.exe'),
               PChar('shell32.dll, OpenAs_RunDLL ' + AFullPath + ' '),
               nil,
               0);
end;

//=============================================================================
//  このFormがアクティブになった時の処理
//  ファイルが選択されている時だけButton1を使用可能とする
//=============================================================================
procedure TForm1.ApplicationEvents1Activate(Sender: TObject);
begin
  //変更があったかも知れないのでフォルダ内を[最新の情報に更新]
  plFileList1.RefreshView;

  Button1.Enabled := plFileList1.SelCount > 0;
  Button2.Enabled := plFileList1.SelCount > 0;
end;

//=============================================================================
//  ファイルリスト部をクリックした時の処理
//=============================================================================
procedure TForm1.plFileList1Click(Sender: TObject);
begin
  ApplicationEvents1Activate(nil);
end;

end.