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/ )