delphi 选择文件夹

function BrowseCallbackProc(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer; stdcall;
begin
if uMsg = BFFM_INITIALIZED then
begin
SendMessage(Wnd, BFFM_SETSELECTION, 1, lpData);
SetWindowText(Wnd, '选择一个目标');
end;
Result := 0;
end;
//hdl: 窗口句柄
//Root: 根目录
//InitDir: 初始化路径
//Hint: 对话框提示语句
function fBrowseFolder(hdl:THandle; const Root: String; const InitDir: string;
Hint: string = '请选择文件夹'): string;
var
Info:TBrowseInfo;
Dir:array[0..260] of char;
ItemId, RootItemIDList:PItemIDList;
Eaten, Attribute: Cardinal;
ID: IShellFolder;
begin
FillChar(Info, SizeOf(TBrowseInfo), #0);
with Info do
begin
hwndOwner := hdl;
SHGetDesktopFolder(ID);
ID.ParseDisplayName(hdl, nil, POleStr(WideString(Root)), Eaten, RootItemIDList, Attribute);
pidlRoot := RootItemIDList;
pszDisplayName := nil;
lpszTitle:= PChar(Hint);
ulFlags:=BIF_RETURNONLYFSDIRS + BIF_NEWDIALOGSTYLE; //如不需要新建按钮，也可不加BIF_NEWDIALOGSTYLE
lpfn := BrowseCallbackProc;
lParam := Integer(PChar(InitDir));
iImage := 0;
end;
ItemId := SHBrowseForFolder(Info);
if ItemId<>nil then
begin
SHGetPathfromIDList(ItemId,@Dir);
GlobalFreePtr(ItemId);
Result:=string(Dir);
end
else
Result:='';
end;