2013年05月06日13:00 更新
ここでは、TBrowseInfoデータとSHBrowseForFolder、BrowseCallbackProcなどの関数を使い、自由に位置とサイズを指定し変更できるWindowsコモンダイアログ「フォルダー参照（選択）」ダイアログを作成表示する方法を示します。（2013-06-17 08:20追加）
以下はWindows共通の[フォルダーの参照（選択）]ダイアログに関する話です。
Windowsソフトでフォルダーを指定する場合、[フォルダーの参照]ダイアログ（以下単にダイアログとします）を使用するのが一般的です。ダイアログにはサイズと位置に関する不便があります。多くのプログラマーとユーザーがダイアログの不便をどのように凌いでいるかという視点から以下のように、ダイアログを３タイプに分類してみます。
ダイアログを自由にサイズ変更できますが、ダイアログの位置は自由にならないというタイプです。
起動時にダイアログの左上隅が画面上で常に同じ位置に固定されていて、ダイアログを大きくサイズ変更すると、次にダイアログを起動するとき、ダイアログの下部（[OK]ボタン、[キャンセル]ボタン）が画面からはみ出して見えなくなることがあり、起動する度にダイアログのサイズと位置を調整しなくてはならないという不便があります。
このタイプはWindows（マイクロソフト）が提供するダイアログをそのまま使用するだけで、プログラムで特別な工夫を施しているわけではありません。
「位置よりサイズを重視するタイプ」と分類しましたが、実際はダイアログの位置とサイズについては不便を感じつつもそういう現状を諦観の心境で受け入れているだけではないかと思います。
ダイアログを希望する位置に表示できますが、ダイアログのサイズは変更できないというタイプです。
位置は親ウィンドウまたは画面の中心という場合が多いようです。
これはダイアログのサイズが小さく固定されているために、フォルダを選択するフォルダツリーの表示領域が狭くなり、フォルダの選択操作がやりにくいという不便があります。
このタイプはⅠタイプのように、ダイアログを希望する位置に表示できないためにダイアログの下部が画面からはみだしてみえなくなったりする不便を解消しようと、ダイアログの作成ログラムに一工夫を加えたものです。しかし、位置を自由に指定できる代償として、サイズ変更ができなくなり、小さいサイズで我慢しなくてはなりません。
ダイアログを自由にサイズ変更できますし、ダイアログの位置も自由に設定できるというタイプです。
位置は自由に設定できるといっても、たいてい親ウィンドウまたは画面の中心ということになります。
フォルダ選択を操作しやすくするために、ダイアログのサイズを大きく変更した場合でも再び起動すると、ダイアログが画面の中心（または希望する位置）に表示され、ダイアログの下部が画面からはみ出して見えなくなるという不便はありません。
このタイプはダイアログ作成プログラムでⅡタイプよりさらに工夫を凝らしたものです。
Windows世界の現状では、数多あるソフトのうち、限りなく100％に近い割合でⅠタイプかⅡタイプの[フォルダーの参照]ダイアログが使用されています。一番便利なⅢタイプは数えるほどしか実例がありません。
インターネット上で私が見つけたものですが、以下にⅢタイプの[フォルダーの参照]ダイアログを使用しているソフトを掲げておきます。もちろん、他にもまだまだあると思います。（2013-03-25）
実はⅢタイプの[フォルダーの参照]ダイアログを使用している、あるソフトに感銘を受けたのが動機ですが、私（鈴川エディタ作者）もⅢタイプのダイアログを作成したいと一念発起し一週間ばかり熱中しました。そして、Ⅲタイプのダイアログを作成しました。
以下に私が作成したⅢタイプのダイアログをテストする簡単なソフトを公開します。上記の話に興味のある方はお試しください。
下記の圧縮ファイル
SelectFolderTest.zip
には次の二つの実行ファイル
簡単ですので、ヘルプはありません。
以下に32bit版の操作手順を示します。64bit版も同じです。
下記の圧縮ファイルにソースファイルと実行ファイルが収納されています。
SelectFolderSource.zip
ソースファイルは開発言語DelphiXE2用ですが、他のプログラム言語がわかる方ならば、要点は理解できるでしょう。
もし、ソースファイルで間違いやこうした方がよいのではないかというご意見がございましたら、ご連絡願います。
[フォルダーの参照]ダイアログはWindowsソフトで共通に使用されているものです。私が公開したソースファイルを元にさらに改良した場合はその要点を公開してほしいと思います。
上記圧縮ファイルに含まれるファイルのうち、二つのソースファイルを示します。
改良した[フォルダーの参照]ダイアログの中心となるソースファイルです。
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.
上記テストプログラム（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.