[ フォルダの参照ダイアログコンポーネント ] [ テストプログラム ]

Delphi Programming / Object Pascal

[掲載 2010年10月10日] [更新 2014年01月03日]　ファイル関連ダイアログコンポーネント類

フォルダ参照ダイアログコンポーネントテストプログラム
動作確認等	Windows 7 U64(SP1) + Delphi XE(UP1) Pro

01_基本的な動作確認用テストプログラム
02_ファイルも表示
03_特殊フォルダ (プリンタ) の表示例
04_Windows Vista 以降で実装された仮想フォルダの表示例

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;