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 关注我收藏该文与我联系

======================================================
在最后，我邀请大家参加新浪APP，就是新浪免费送大家的一个空间，支持PHP+MySql，免费二级域名，免费域名绑定 这个是我邀请的地址，您通过这个链接注册即为我的好友，并获赠云豆500个，价值5元哦！短网址是http://t.cn/SXOiLh我创建的小站每天访客已经达到2000+了，每天挂广告赚50+元哦，呵呵，饭钱不愁了，\(^o^)/