Delphi 选择文件夹对话框 (有新建文件夹按钮)修正版

其他网站也有这份代码,不过有问题,我修改后发表上来.

uses ShlObj;

function SelectFolderDialog(const Handle: integer; const Caption: string;
const InitFolder: WideString; var SelectedFolder: string): boolean;
var
BInfo: _browseinfo;
Buffer: array[0..MAX_PATH] of Char;
ID: IShellFolder;
Eaten, Attribute: Cardinal;
ItemID: PItemidlist;
begin
Result := False;
BInfo.HwndOwner := Handle;
BInfo.lpfn := nil;
BInfo.lpszTitle := Pchar(Caption);
BInfo.ulFlags := BIF_RETURNONLYFSDIRS + BIF_NEWDIALOGSTYLE;
SHGetDesktopFolder(ID);
ID.ParseDisplayName(0, nil, PWideChar(InitFolder), Eaten, ItemID, Attribute);
BInfo.pidlRoot := ItemID;
GetMem(BInfo.pszDisplayName, MAX_PATH);
try
    if SHGetPathFromIDList(SHBrowseForFolder(BInfo), Buffer) then
    begin
      SelectedFolder := Buffer;
      if Length(SelectedFolder) <> 3 then
        SelectedFolder := SelectedFolder + '\';
      result := True;
    end
    else
    begin
      SelectedFolder := '';
      Result := False;
    end;
finally
    FreeMem(BInfo.pszDisplayName);
end;
end;

procedure TFrmMain.EdtDirPathButtonClick(Sender: TObject);
var
NewDir: string;
begin
if SelectFolderDialog(Handle, '选择', '', NewDir) then
    EdtDirPath.Text := NewDir;
end;