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
|
请发表评论