delphi 选择文件夹目录保存

Windows目录对话框是一个标准的WindowsUI控件，其可以列出一个目录列表，并且可以显示新增按钮。由于Delphi中并没有提供对于该控件的封装，所以打开它是个问题。网上有多种方法，试举几例：

1、使用Win31目录下的DriverList、DirectoryList、FileList和FileFilterList四个控件进行组合来获取当前目录，操作复杂，也不美观，对程序EXE体积影响明显

2、使用Samples下的ShellTreeView，效果很好，但对程序EXE体积也是增加明显

3、让用户直接定位文件，通过对话框OpenDialog来实现，但无法限制用户定位文件的权限，而且可能在程序中使用相对目录时冲突报错

4、利用FileCtrl单元中的SelectDirectory函数定位到文件夹，且可以用Root参数限定根目录上限，但总是弹出在右下角

5、我个人是使用以下方法直接调用Windows目录对话框，向原作者表示衷心感谢！

unit BrowseForFolderU;

interface

function BrowseForFolder(const browseTitle:string;
  const initialFolder:string=''):string;

implementation

uses Windows,shlobj;

var
  lg_StartFolder:string;

function BrowseForFolderCallBack(Wnd:HWND;uMsg:UINT;
  lParam,lpData:LPARAM):Integer stdcall;
begin
  if uMsg=BFFM_INITIALIZED then
    SendMessage(Wnd,BFFM_SETSELECTION,1,Integer(@lg_StartFolder[1]));
  result:=0;
end;

function BrowseForFolder(const browseTitle:string;
  const initialFolder:string=''):string;
const
  BIF_NEWDIALOGSTYLE=$40;
var
  browse_info:TBrowseInfo;
  folder:array[0..MAX_PATH] of char;
  find_context:PItemIDList;
begin
  FillChar(browse_info,SizeOf(browse_info),#0);
  lg_StartFolder:=initialFolder;
  browse_info.pszDisplayName:=@folder[0];
  browse_info.lpszTitle:=PChar(browseTitle);
  browse_info.ulFlags:=BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
  if initialFolder<>'' then
    browse_info.lpfn:=BrowseForFolderCallBack;
  find_context:=SHBrowseForFolder(browse_info);
  if Assigned(find_context) then
  begin
    if SHGetPathFromIDList(find_context,folder) then
      result:=folder
    else
      result:='';
    GlobalFreePtr(find_context);
  end
  else
    result:='';
end;

end.

调用代码：

uses
　BrowseForFolderU；

procedure TForm1.Button1Click(Sender: TObject);
var opath,dpath,omsg:String;
begin
  dpath:='c:';
  omsg:='请选择路径：';
  opath:=BrowseForFolder(omsg,dpath);
  if opath<>'' then Edit1.Text:=opath
  else
    Application.MessageBox('没有选择路径','系统提示',MB_OK+MB_ICONERROR);
end;

 

参考：

http://blog.sina.com.cn/s/blog_7d8514840101d1is.html

 

转载于:https://www.cnblogs.com/yangxuming/p/6892625.html