Delphi开启Windows目录对话框代码

Windows目录对话框是一个标准的WindowsUI控件，其可以列出一个目录列表，并且可以显示新增按钮。

该段代码分为两个部分：(1)控件代码 (2)调用代码

(1)控件代码。代码如下

unit BrowseForFolderU;

interface
function BrowseForFolder(const browseTitle: String;
const initialFolder: String = ''): String;

implementation
uses Windows, shlobj;
var
lg_StartFolder: String;

///
// Call back function used to set the initial browse directory.
///
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.

(2)调用代码。

 var
  Path, defaultPath, Msg: string;
begin
  defaultPath := 'c:\'; //目录对话框的初始目录
  Msg := '请选择数据表所在目录'; //目录对话框上显示的提示信息
  Path := BrowseForFolder(Msg, defaultPath); //启动Windows目录对话框。
  if Path = '' then //如果返回地址为空，则报错
  begin
    Msg := '你没有选取任何目录！';
    Application.MessageBox(PChar(Msg), 'WARNING', 0);
    Exit;
  end
else
  begin

  ShowMessage('祝你成功！'); 

  end;
end;

//(本文出处：南山古桃(nsgtao)的百度空间：http://hi.baidu.com/nsgtao/ )

转载于:https://www.cnblogs.com/bjxsky/articles/2819720.html