Windows[フォルダーの参照]ダイアログ:Browse for Folder Dialog

鈴川エディタホームページ


2013年05月06日13:00 更新

ここでは、TBrowseInfoデータとSHBrowseForFolder、BrowseCallbackProcなどの関数を使い、自由に位置とサイズを指定し変更できるWindowsコモンダイアログ「フォルダー参照(選択)」ダイアログを作成表示する方法を示します。(2013-06-17 08:20追加)

目次


更新

ページトップ


ダイアログの話

ページトップ

以下はWindows共通の[フォルダーの参照(選択)]ダイアログに関する話です。

Windowsソフトでフォルダーを指定する場合、[フォルダーの参照]ダイアログ(以下単にダイアログとします)を使用するのが一般的です。ダイアログにはサイズと位置に関する不便があります。多くのプログラマーとユーザーがダイアログの不便をどのように凌いでいるかという視点から以下のように、ダイアログを3タイプに分類してみます。

  1. 位置よりサイズを重視するタイプ。

    ダイアログを自由にサイズ変更できますが、ダイアログの位置は自由にならないというタイプです。
    起動時にダイアログの左上隅が画面上で常に同じ位置に固定されていて、ダイアログを大きくサイズ変更すると、次にダイアログを起動するとき、ダイアログの下部([OK]ボタン、[キャンセル]ボタン)が画面からはみ出して見えなくなることがあり、起動する度にダイアログのサイズと位置を調整しなくてはならないという不便があります。
    このタイプはWindows(マイクロソフト)が提供するダイアログをそのまま使用するだけで、プログラムで特別な工夫を施しているわけではありません。
    「位置よりサイズを重視するタイプ」と分類しましたが、実際はダイアログの位置とサイズについては不便を感じつつもそういう現状を諦観の心境で受け入れているだけではないかと思います。

  2. サイズより位置を重視するタイプ。

    ダイアログを希望する位置に表示できますが、ダイアログのサイズは変更できないというタイプです。
    位置は親ウィンドウまたは画面の中心という場合が多いようです。
    これはダイアログのサイズが小さく固定されているために、フォルダを選択するフォルダツリーの表示領域が狭くなり、フォルダの選択操作がやりにくいという不便があります。
    このタイプはⅠタイプのように、ダイアログを希望する位置に表示できないためにダイアログの下部が画面からはみだしてみえなくなったりする不便を解消しようと、ダイアログの作成ログラムに一工夫を加えたものです。しかし、位置を自由に指定できる代償として、サイズ変更ができなくなり、小さいサイズで我慢しなくてはなりません。

  3. サイズも位置も重視するタイプ。

    ダイアログを自由にサイズ変更できますし、ダイアログの位置も自由に設定できるというタイプです。
    位置は自由に設定できるといっても、たいてい親ウィンドウまたは画面の中心ということになります。
    フォルダ選択を操作しやすくするために、ダイアログのサイズを大きく変更した場合でも再び起動すると、ダイアログが画面の中心(または希望する位置)に表示され、ダイアログの下部が画面からはみ出して見えなくなるという不便はありません。
    このタイプはダイアログ作成プログラムでⅡタイプよりさらに工夫を凝らしたものです。

Windows世界の現状では、数多あるソフトのうち、限りなく100%に近い割合でⅠタイプかⅡタイプの[フォルダーの参照]ダイアログが使用されています。一番便利なⅢタイプは数えるほどしか実例がありません。

インターネット上で私が見つけたものですが、以下にⅢタイプの[フォルダーの参照]ダイアログを使用しているソフトを掲げておきます。もちろん、他にもまだまだあると思います。(2013-03-25)


ダイアログのテスト

ページトップ

実はⅢタイプの[フォルダーの参照]ダイアログを使用している、あるソフトに感銘を受けたのが動機ですが、私(鈴川エディタ作者)もⅢタイプのダイアログを作成したいと一念発起し一週間ばかり熱中しました。そして、Ⅲタイプのダイアログを作成しました。

以下に私が作成したⅢタイプのダイアログをテストする簡単なソフトを公開します。上記の話に興味のある方はお試しください。

下記の圧縮ファイル
SelectFolderTest.zip
には次の二つの実行ファイル

  1. SelectFolder32.exe(32bit版)
  2. SelectFolder64.exe(64bit版)
が収納されています。

簡単ですので、ヘルプはありません。
以下に32bit版の操作手順を示します。64bit版も同じです。

  1. 上記の圧縮ファイル
    SelectFolderTest.zip
    をクリックするとダウンロードします。
  2. ダウンロードした圧縮ファイル
    SelectFolderTest.zip
    を解凍します。
  3. インストールはありません。フォルダは任意の場所でかまいません。
  4. 解凍したフォルダの中で
    実行ファイル
    SelectFolder32.exe
    をダブルクリックします。
  5. SelectFolder32.exeが起動し、メインウィンドウが表示されます。
  6. メインウィンドウのタイトルは
    [TEST]:フォルダーの参照 32
    です。
  7. メインウィンドウで[参照]ボタンをクリックします。
  8. [フォルダーの参照 32]ダイアログが表示されます。
  9. 任意のフォルダ(Aとします)を選択します。
  10. ここで、必要がなくてもダイアログのサイズを大きく変更してみます。このときのダイアログのサイズをBとします。
  11. [OK]ボタンをクリックします。
  12. [フォルダーの参照 32]ダイアログは閉じます。
  13. プログラムのメインウィンドウ([TEST]:フォルダーの参照 32)に戻ります。
  14. [フォルダ]テキストボックスに選択したフォルダ名(A)が表示されます。
  15. もう一度[参照]ボタンをクリックします。
  16. [フォルダーの参照 32]ダイアログ
    がBサイズで画面の中心に表示されるはずです。
  17. この次の操作は9からの繰り返しになります。


ソースファイル

ページトップ

下記の圧縮ファイルにソースファイルと実行ファイルが収納されています。
SelectFolderSource.zip
ソースファイルは開発言語DelphiXE2用ですが、他のプログラム言語がわかる方ならば、要点は理解できるでしょう。
もし、ソースファイルで間違いやこうした方がよいのではないかというご意見がございましたら、ご連絡願います。
[フォルダーの参照]ダイアログはWindowsソフトで共通に使用されているものです。私が公開したソースファイルを元にさらに改良した場合はその要点を公開してほしいと思います。

上記圧縮ファイルに含まれるファイルのうち、二つのソースファイルを示します。

  1. S_FolderEx.pas
  2. SelectFolderExF.pas

S_FolderEx.pas

改良した[フォルダーの参照]ダイアログの中心となるソースファイルです。

unit S_FolderEx;

interface

uses
  Windows, Messages, Classes, Controls, ShlObj, ActiveX;

type
  TFolderEx = class(TComponent)
  private
    FOwner: TObject;
    FTitle: string;
    FComment: string;
    FDefaultFolder: string;
    function GetFolderFromCommonDlg(AComment: string): string;
    procedure SetWindow_Pos_Size;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: string;
    property Title: string read FTitle write FTitle;
    property Comment: string read FComment write FComment;
    property DefaultFolder: string read FDefaultFolder write FDefaultFolder;
  end;

var
  FolderEx: TFolderEx = nil;

implementation

const
  ID_EDIT   = $3744;  // Edit
  ID_NEWBTN = $3746;  // Button

var
  BrowseInfo: TBrowseInfo;
  hDlg: THandle = 0;
  hEdit: THandle = 0;
  hNewBtn: THandle = 0;
  PathName: array[0..MAX_PATH] of Char;
  PathNameA: array[0..MAX_PATH] of Char;
  OrgProc: FARPROC = nil;
  DidShow: Boolean = False;
  TextBoxChanged: Boolean = False;

function SubProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): Integer; stdcall;
begin
  case uMsg of
    WM_SHOWWINDOW:
      if not DidShow and (FolderEx <> nil) then
      begin
        DidShow := True;
        FolderEx.SetWindow_Pos_Size;
      end;
  end;
  Result := CallWindowProc(OrgProc, hWnd, uMsg, wParam, lParam);
end;

function BrowseCallbackProc(hWnd: HWND; uMsg: UINT; lParam: LPARAM; lpData: LPARAM): Integer; stdcall;
var
  R: TRect;
  Pt: TPoint;
begin
  case uMsg of
    BFFM_INITIALIZED:
      begin
        hDlg := hWnd;
        hEdit := GetDlgItem(hDlg,ID_EDIT);
        hNewBtn := GetDlgItem(hDlg,ID_NEWBTN);
        if hNewBtn > 0 then
        begin
          SetWindowText(hNewBtn, '新規作成(&N)');
          GetWindowRect(hNewBtn, R);
          Pt := Point(R.Left, R.Top);
          Windows.ScreenToClient(hDlg, Pt);
          MoveWindow(hNewBtn, Pt.X, Pt.Y, 100, R.Bottom - R.Top, False);
        end;
        SendMessage(hWnd, BFFM_SETSELECTION, WPARAM(TRUE), lpData);
        OrgProc := Pointer(GetWindowLong(hDlg, GWL_WNDPROC));
        SetWindowLong(hDlg, GWL_WNDPROC, NativeInt(@SubProc));
      end;
    BFFM_SELCHANGED:
      if BrowseInfo.ulFlags and BIF_EDITBOX = BIF_EDITBOX then
      begin
        TextBoxChanged := False;
        SHGetPathFromIDList(PItemIDList(lParam), PathName);
        if (hEdit > 0) and (PathName <> '') then
        SendMessage(hEdit, WM_SETTEXT, 0, NativeInt(@PathName));
      end;
    BFFM_VALIDATEFAILED:
      if BrowseInfo.ulFlags and BIF_EDITBOX = BIF_EDITBOX then
      begin
        TextBoxChanged := True;
        Windows.GetWindowText(hEdit, PathNameA, MAX_PATH);
      end;
  end;
  Result := 0;
end;

constructor TFolderEx.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FOwner := AOwner;
  FTitle := 'フォルダーの参照';
  FComment := '';
  FDefaultFolder := 'C:\';
  DidShow := False;
  TextBoxChanged := False;
end;

destructor TFolderEx.Destroy;
begin
  SetWindowLong(hDlg, GWL_WNDPROC, NativeInt(OrgProc));
  inherited Destroy;
end;

procedure TFolderEx.SetWindow_Pos_Size;
var
  R0,R: TRect;
  W0,H0,W,H,L,T: Integer;
begin
  if hDlg > 0 then
  begin
    Sleep(200);
    SystemParametersInfo(SPI_GETWORKAREA, 0, R0, 0);
    GetWindowRect(hDlg, R);
    SetWindowText(hDlg, FTitle);
    W0 := R0.Right - R0.Left;
    H0 := R0.Bottom - R0.Top;
    W := R.Right - R.Left;
    H := R.Bottom - R.Top;
    if W > W0 then
      W := W0;
    if H > H0 then
      H := H0;
    L := (W0 - W) div 2;
    T := (H0 - H) div 2;
    if L < R0.Left then
      L := R0.Left;
    if T < R0.Top then
      T := R0.Top;
    SetWindowPos(hDlg, HWND_TOP, L, T, W, H, SWP_SHOWWINDOW);
  end;
end;

function TFolderEx.Execute: string;
begin
  Result := '';
  hDlg := 0;
  Result := GetFolderFromCommonDlg(FComment);
end;

function TFolderEx.GetFolderFromCommonDlg(AComment: string): string;
var
  FolderPidl: PItemIDList;
  AMalloc: IMalloc;
begin
  Result := '';
  ShGetMalloc(AMalloc);
  FolderPidl := nil;
  FillChar(BrowseInfo, SizeOf(BrowseInfo), #0);
  BrowseInfo.hwndOwner := TWinControl(FOwner).Handle;
  BrowseInfo.lpfn      := @BrowseCallbackProc;
  BrowseInfo.lpszTitle := PChar(AComment);
  BrowseInfo.pidlRoot  := nil;
  BrowseInfo.lParam    := LPARAM(PChar(FDefaultFolder));
  BrowseInfo.ulFlags   := BIF_RETURNONLYFSDIRS or BIF_EDITBOX or BIF_VALIDATE or
                          BIF_NEWDIALOGSTYLE or BIF_BROWSEFORCOMPUTER;
  FolderPidl := SHBrowseForFolder(BrowseInfo);
  if FolderPidl <> nil then
  try
    if TextBoxChanged then
      Result := PathNameA
    else
    begin
      SHGetPathFromIDList(FolderPidl, PathName);
      Result := PathName;
    end;
  finally
    AMalloc.Free(FolderPidl);
  end;
end;

end.

SelectFolderExF.pas

上記テストプログラム(SelectFolder32.exe、SelectFolder64.exe)のメインウィンドウのソースファイルです。


unit SelectFolderExF;

interface

uses
  Windows, Messages, SysUtils, Classes, Forms, StdCtrls, Controls;

type
  TSelectFolderExForm = class(TForm)
    FolderBtn: TButton;
    FolderEdit: TEdit;
    FolderStaticText: TStaticText;
    CloseBtn: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure CloseBtnClick(Sender: TObject);
    procedure FolderBtnClick(Sender: TObject);
  private
    InitDir: string;
  public
    { Public 宣言 }
  end;

var
  SelectFolderExForm: TSelectFolderExForm = nil;

implementation

uses
  S_FolderEx;

{$R *.dfm}

procedure TSelectFolderExForm.FormCreate(Sender: TObject);
begin
{$IFDEF WIN64}
  Self.Caption := '[TEST] フォルダーの参照 64';
{$ELSE}
  Self.Caption := '[TEST] フォルダーの参照 32';
{$ENDIF}
  InitDir := '';
end;

procedure TSelectFolderExForm.FormShow(Sender: TObject);
var
  R: TRect;
begin
  R := Screen.WorkAreaRect;
  Self.Left := R.Left + 10;
  Self.Top := R.Top + 10;
end;

procedure TSelectFolderExForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
  SelectFolderExForm := nil;
end;

procedure TSelectFolderExForm.CloseBtnClick(Sender: TObject);
begin
  Self.Close;
end;

procedure TSelectFolderExForm.FolderBtnClick(Sender: TObject);
var
  Dir: string;
begin
  FolderEx := TFolderEx.Create(Self);
  if FolderEx <> nil then
  begin
    try
{$IFDEF WIN64}
      FolderEx.Title := 'フォルダーの参照 64';
{$ELSE}
      FolderEx.Title := 'フォルダーの参照 32';
{$ENDIF}
      FolderEx.Comment := 'フォルダを指定してください。';
      if InitDir = '' then
        FolderEx.DefaultFolder := 'C:\'
      else
        FolderEx.DefaultFolder := InitDir;
      Dir := FolderEx.Execute;
      if Dir <> '' then
      begin
        FolderEdit.Text := Dir;
        InitDir := Dir;
      end;
    finally
      FreeAndNil(FolderEx);
    end;
  end;
end;

end.


ページトップ


Copyright (c) 2000 - 2017 鈴木由彦(Yoshihiko Suzuki)
e-Mail:szkwjp@gmail.com
HomePage:http://www.szkwjp.com/