Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2010年10月10日] [更新 2014年01月03日]　ファイル関連ダイアログコンポーネント類
フォルダ参照ダイアログコンポーネント
テストプログラム
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro






01_基本的な動作確認用テストプログラム


フォルダの参照ダイアログコンポーネントのテストプログラムです．コンポーネントを利用する際の参考にしてください．

下のサンプルでは，ルートフォルダを指定していません．したがって，デスクトップがルートフォルダとなります．Options プロパティで bifNewDialogStyle, bifUseNewUI を指定して，新しいスタイルで新しい UI のダイアログを表示します．


図1
設計時画面
  • 本ページのサンプルは全て同じ
図2
実行画面例
図3
[OK] でダイアログ終了
  • フォルダの表示名を TStaticText に表示
  • Directory プロパティにすれば実フォルダ名または GUID 文字列となる

リスト1
フォルダの参照ダイアログコンポーネントの基本的な動作確認用テスト		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    plBrowseFolder1: TplBrowseFolder;
    StaticText1: TStaticText;
    procedure Button1Click(Sender: TObject);
    procedure plBrowseFolder1SelectionChanged(Sender: TObject; Wnd: HWND;
      Directory: string; var StatusText: string; var OKBtnEnabled: Boolean);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォルダの参照ダイアログ表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  Options : TplBrowseOptions;
begin
  Options := plBrowseFolder1.Options;
  //表示のオプションを追加
  Include(Options, bifStatusText);         //ステータステキスト表示
  Include(Options, bifNewDialogStyle);     //新しいスタイル
  Include(Options, bifUseNewUI);           //新しいUI
  plBrowseFolder1.Options := Options;

  plBrowseFolder1.FormLeft := 500;
  plBrowseFolder1.FormTop  := 300;

  plBrowseFolder1.Title   := 'タイトル部';
  plBrowseFolder1.Caption := 'フォルダの参照ダイアログのテスト';

  if plBrowseFolder1.Execute then begin
    //plBrowseFolder1.Directory;にすれば実パス名
    StaticText1.Caption := plBrowseFolder1.FolderName;
  end;
  //終了時の位置とサイズはここで取得可能(プロパティFormHeight等)
end;

//=============================================================================
//  SelectionChangedイベント
//  選択フォルダを変更すると発生
//  新しいスタイルのダイアログでは引数StatusTextは無効
//=============================================================================
procedure TForm1.plBrowseFolder1SelectionChanged(Sender: TObject; Wnd: HWND;
  Directory: string; var StatusText: string; var OKBtnEnabled: Boolean);
begin
  StatusText := 'ステータス部';
end;

end.



02_ファイルも表示


ファイル名も表示するには，Options プロパティに bifBrowseIncludeFiles を含めます．


図4
実行画面

リスト2
ファイルも表示 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    plBrowseFolder1: TplBrowseFolder;
    StaticText1: TStaticText;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォルダの参照ダイアログ表示
//  OptionsにbifBrowseIncludeFilesを追加してファイルも表示
//  ルートフォルダを指定
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  Options : TplBrowseOptions;
begin
  Options := plBrowseFolder1.Options;
  //表示のオプションを追加
  Include(Options, bifNewDialogStyle);     //新しいスタイル
  Include(Options, bifUseNewUI);           //新しいUI
  Include(Options, bifBrowseIncludeFiles); //フォルダ以外のファイルも表示
  plBrowseFolder1.Options := Options;

  //ルートディレクトリを指定
  //RootDirプロパティはRootSpecialDirがsfNoneでないと有効にならない
  plBrowseFolder1.InitDir := ExpandFileName('../../ABC株式会社');
  plBrowseFolder1.RootDir := ExpandFileName('../../ABC株式会社');
  plBrowseFolder1.RootSpecialDir := sfNone;

  plBrowseFolder1.Title   := 'タイトル部';
  plBrowseFolder1.Caption := 'フォルダの参照ダイアログのテスト';

  if plBrowseFolder1.Execute then begin
    //plBrowseFolder1.Directory;にすれば実パス名
    StaticText1.Caption := plBrowseFolder1.FolderName;
  end;
  //終了時の位置とサイズはここで取得可能(プロパティFormHeight等)
end;

end.



03_特殊フォルダ ( プリンタ ) の表示例


仮想フォルダ等の特殊フォルダは，Options プロパティと CSIDL_XXX の値で設定できます．
次のコードは [プリンタ] フォルダを表示する例です．


図5
実行例

リスト3
特殊フォルダの [プリンタ] を表示		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    plBrowseFolder1: TplBrowseFolder;
    StaticText1: TStaticText;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォルダの参照ダイアログ表示
//  ルートフォルダをプリンタを指定
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  Options : TplBrowseOptions;
begin
  Options := [];
  //表示のオプションを追加
  Include(Options, bifNewDialogStyle);     //新しいスタイル
  Include(Options, bifUseNewUI);           //新しいUI
  Include(Options, bifBrowseForPrinter);   //選択可能フォルダの指定
  plBrowseFolder1.Options := Options;

  //ルートディレクトリを指定
  plBrowseFolder1.RootSpecialDir := sfPrinters;

  if plBrowseFolder1.Execute then begin
    //StaticText1.Caption := plBrowseFolder1.Directory;//にすれば実パス名
    StaticText1.Caption := plBrowseFolder1.FolderName;
  end;
  //終了時の位置とサイズはここで取得可能(プロパティFormHeight等)
end;

end.



04_Windows Vista 以降で実装された仮想フォルダの表示例


Windows Vista 以降で実装された特殊フォルダには，本コンポーネントで扱っている CSIDL_XXX にはない仮想フォルダがあります．これらの仮想フォルダは [460_特殊フォルダのフルパスを取得] のサンプルで使用している FOLDERID_XXX が使用できます．
次のサンプルは，Windows 7 で実装された仮想フォルダ [ライブラリ] を表示します．
本サンプルで使用している SHGetKnownFolderPath 関数は，Delphi 2010 以降で使用可能です．


図6
[ライブラリ] フォルダ

リスト4
Windows Vista 以降で実装された仮想フォルダの表示例		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    plBrowseFolder1: TplBrowseFolder;
    StaticText1: TStaticText;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ShlObj, KnownFolders;

{$R *.dfm}

//=============================================================================
//  フォルダの参照ダイアログ表示
//  ルートフォルダを指定
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  Options     : TplBrowseOptions;
  FolderID    : TGUID;
  pFolderPath : PChar;
begin
  Options := plBrowseFolder1.Options;
  //表示のオプションを追加
  //新しいスタイルとする
  Include(Options, bifNewDialogStyle);
  plBrowseFolder1.Options := Options;

  //SHGetKnownFolderPathを使用して特殊フォルダのパス名を取得
  //ここではWindows7で実装された[ライブラリ]とする
  FolderID := FOLDERID_Libraries;
  if SHGetKnownFolderPath(FolderID, 0, 0, pFolderPath) = S_OK then begin

    //ルートディレクトリを指定
    //RootDirプロパティはRootSpecialDirがsfNoneでないと有効にならない
    plBrowseFolder1.RootDir        := pFolderPath;
    plBrowseFolder1.RootSpecialDir := sfNone;

    plBrowseFolder1.Title   := 'タイトル部';
    plBrowseFolder1.Caption := 'フォルダの参照ダイアログのテスト';

    if plBrowseFolder1.Execute then begin
      //plBrowseFolder1.Directory;にすれば実パス名
      StaticText1.Caption := plBrowseFolder1.FolderName;
    end;
    //終了時の位置とサイズはここで取得可能(プロパティFormHeight等)
  end;
end;

end.


フォルダの参照ダイアログのルートフォルダ，あるいは表示時に選択状態にするフォルダは，実フォルダ名または GUID 文字列で指定可能です．
例えば上のコードと同じ [ライブラリ] は次のコードでルートフォルダにできます．		 


  plBrowseFolder1.RootDir        := '::{031E4825-7B94-4DC3-B131-E946B44C8DD5}';
  plBrowseFolder1.RootSpecialDir := sfNone;


また選択フォルダは次のように，InitDir で設定できます．
デフォルトの設定では，[ライブラリ] は選択状態にできても [OK] ボタンは押せません．{OK] ボタンを有効にするには，Options プロパティに bifReturnFSAncestors を追加しておきます．		 


  plBrowseFolder1.InitDir:= '::{031E4825-7B94-4DC3-B131-E946B44C8DD5}';


上のテストコードでは，新しいスタイルのフォルダ参照ダイアログを表示していますが，従来型のスタイルとすると，下図のように，表示名が Libraries となります．また，Directory プロパティが返す値は GUID の文字列ではなく，実パス名となります．この実パス名は，SHGetKnownFolderPath 関数で取得した値と同じとなります．


図7
旧スタイルのダイアログ
  • [ライブラリ] は [Libraries] となる
図8
[ライブラリ] の実パス名
  • ログオン (ログイン) ユーザによって異なる値となる
 

procedure TForm1.Button1Click(Sender: TObject);
var
  FolderID    : TGUID;
  pFolderPath : PChar;
begin
  FolderID := FOLDERID_Libraries;
  if SHGetKnownFolderPath(FolderID, 0, 0, pFolderPath) = S_OK then begin

    //ルートディレクトリを指定
    //RootDirプロパティはRootSpecialDirがsfNoneでないと有効にならない
    plBrowseFolder1.RootDir        := pFolderPath;
    plBrowseFolder1.RootSpecialDir := sfNone;

    plBrowseFolder1.Title   := 'タイトル部';
    plBrowseFolder1.Caption := 'フォルダの参照ダイアログのテスト';

    if plBrowseFolder1.Execute then begin
      StaticText1.Caption := plBrowseFolder1.Directory;
    end;
  end;
end;