2007年1月30日星期二

Delphi开启Windows目录对话框代码

今天整理以往的项目代码,发现自己以前在网上找到的一段Delphi开启Windows目录对话框的代码,觉得对许多Delphi初学者很有用,特转贴出来。由于时间过久已经无法知道是从什么地方摘录的,在此特向原作者表示感谢!

Windows目录对话框是一个标准的WindowsUI控件,其可以列出一个目录列表,并且可以显示新增按钮。由于Delphi中并没有提供对于该控件的封装,所以新手(包括当年的我)大多使用Win31目录下的DriverList、DirectoryList、FileList和 FileFilterList四个控件进行组合来获取当前目录,这样操作复杂且不美观。有的高手可以直接用WindowsAPI调用Windows目录对话框,但我确直到找到该段代码前还是使用最原始的方法{叹自己的懒惰呀!}

该段代码分为两个部分:(1)控件代码 (2)调用代码
(1)控件代码:由于该控件没有封装成Delphi控件格式,其使用方法有些原始,就是将它的源文件BrowseForFolderU.pas复制到当前项目目录并添加到当前项目中。代码如下{是别人高手写的,致敬呀......}
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;

///////////////////////////////////////////////////////////////////
// This function allows the user to browse for a folder
//
// Arguments:-
// browseTitle : The title to display on the browse dialog.
// initialFolder : Optional argument. Use to specify the folder
// initially selected when the dialog opens.
//
// Returns: The empty string if no folder was selected ( i.e. if the
// user clicked cancel), otherwise the full folder path.
///////////////////////////////////////////////////////////////////
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)调用代码:和一般函数调用很类似。先在调用窗口pas文件前引用一下该控件文件
uses
 BrowseForFolderU;
然后是"八股"代码
procedure TForm1.BtnSampleExecute(Sender: TObject); //演示按钮Click事件函数
var
oPath,oPath1,outMsg:String;
begin
oPath1 := 'c:\';//目录对话框的初始目录
outMsg := 'Windows目录对话框演示';//目录对话框上显示的提示信息
oPath := BrowseForFolder(outMsg,oPath1);//启动Windows目录对话框,一句话就解决了。
if oPath = '' then //如果返回地址为空,则报错
begin
outMsg := '你没有选取任何目录!';
Application.MessageBox(PChar(outMsg),'WARNING',0);
Exit;
end;
else //否则由oPath中提取选取目录地址,进行操作
begin
   //你的操作代码
end;
end;

就这么简单咯,希望能给Delphi初学者一点帮助。

0 评论: