delphi 选择文件夹

 

 

uses ...ShlObj, ActiveX; 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;