unit Unit1;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, Shlobj, ActiveX, StdCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
{フォルダの参照ダイアログ用コールバック関数}
function BrowseCallback(hWnd: HWND; uMsg: UINT; lParam: LPARAM;
lpData: LPARAM): integer; stdcall; export;
function OpenFolderDialog(var FolderPath: string):Boolean;
var
Form1: TForm1;
implementation
{$R *.DFM}
{======================フォルダ選択ダイアログ表示用==================}
{フォルダの参照ダイアログ用コールバック関数}
function BrowseCallback(hWnd: HWND; uMsg: UINT; lParam,
lpData: LPARAM):integer;
var
PathName: array[0..MAX_PATH] of Char;
begin
Result := 0;
case uMsg of
{最初に表示するフォルダ}
BFFM_INITIALIZED:
begin
SendMessage(hWnd, BFFM_SETSELECTION,1,LongInt(lpData));
end;
{フォルダ参照時にパスを表示}
BFFM_SELCHANGED:
begin
SHGetPathFromIDList(PItemIDList(lParam), PathName);
SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, LongInt(@PathName));
end;
end;
end;
{フォルダ参照ダイアログを開く}
function OpenFolderDialog(var FolderPath: string): Boolean;
var
Malloc: IMalloc;
BrowseInfo: TBrowseInfo;
DisplayPath: array[0..MAX_PATH] of Char;
IDList: PItemIdList;
Buffer,pFolderPath: PChar;
begin
Result := False;
if Succeeded(SHGetMalloc(Malloc)) then
begin //IMallocのポインタを取得できたら
pFolderPath := pChar(FolderPath); //初期フォルダ指定用
{BrowseInfo構造体を初期化}
with BrowseInfo do
begin
hwndOwner := GetForegroundWindow();
pidlRoot := nil;
pszDisplayName := DisplayPath; //表示名用バッファ
lpszTitle := 'フォルダを選択して下さい。';
//通常のフォルダのみ参照可能（特殊フォルダは参照できない）
ulFlags := BIF_RETURNONLYFSDIRS or BIF_STATUSTEXT;
lpfn := @BrowseCallback; //コールバック関数指定
lParam := LongInt(pFolderPath); //初期フォルダ指定
iImage := 0;
end;
IDList := SHBrowseForFolder(BrowseInfo);//フォルダ参照ダイアログを表示
if IDList<>nil then //値が返ってきたら
begin
Buffer := Malloc.Alloc(MAX_PATH); //フォルダパス取得用バッファ
try
SHGetPathFromIDList(IDList, Buffer);//フォルダパスを取得
FolderPath := String(Buffer);
finally
Malloc.Free(Buffer);
end;
Malloc.Free(IDList);
Result := True;
end;
end;
end;
{=======================フォルダ選択ダイアログ表示用====ここまで===}
//参照ボタンクリック
procedure TForm1.Button1Click(Sender: TObject);
var
Dir: String;
begin
Dir := 'c:';
if OpenFolderDialog(Dir) then
Edit1.Text := Dir;
end;
end.
|
フォルダ選択ダイアログ
