Delphi2010显示选择文件夹对话框 (有新建按钮)

之前发的那个Delphi 显示选择文件夹对话框 (有新建按钮) 是D7版本的...升级到2010后居然不能直接使用

仔细研究发现原来是_browseinfoA类型变成了BROWSEINFO类型

其他基本不用变

uses ShlObj;

 

 1 function SelectFolderDialog(const Handle:integer;const Caption:string;
 2               const InitFolder:string;var SelectedFolder:string):boolean;
 3 var
 4   BInfo: BROWSEINFO;
 5   Buffer: array[0..MAX_PATH] of Char;
 6   ID: IShellFolder;
 7   Eaten, Attribute: Cardinal;
 8   ItemID: PItemidlist;
 9 begin
10   with BInfo do
11   begin
12     HwndOwner := Handle;
13     lpfn := nil;
14     lpszTitle := PWideChar(Caption);
15     ulFlags := BIF_RETURNONLYFSDIRS+BIF_NEWDIALOGSTYLE;
16     SHGetDesktopFolder(ID);
17     ID.ParseDisplayName(0,nil,'\',Eaten,ItemID,Attribute);
18     pidlRoot := ItemID;
19     GetMem(pszDisplayName, MAX_PATH);
20   end;
21   if SHGetPathFromIDList(SHBrowseForFolder(BInfo), Buffer) then
22   begin
23     SelectedFolder := Buffer;
24     if Length(SelectedFolder)<>3 then
25       SelectedFolder := SelectedFolder;
26     result := True;
27   end
28   else begin
29     SelectedFolder := '';
30     result := False;
31   end;
32 end;

 

调用方法：

 

 procedure TForm1.Button1Click(Sender: TObject);
2 var
3   NewDir:string;
4 begin
5 if SelectFolderDialog(Handle,'选择目录','C:\',NewDir) then
6        Label1.Caption:=NewDir;
7 end;