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;

//=============================================================================
//  １つ上の階層のフォルダを選択
//  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 := 'ＭＳ Ｐゴシック';
    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.

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.

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.

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.

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.