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;

posted @ 2019-09-09 16:33  大米粥11  阅读(457)  评论(0编辑  收藏  举报