如何设置弹出window选择目录窗口的默认路径？

Question

//从别人那里copy了这个函数，但不是知道怎么设置它的默认路径function SelectPath(const Title: string;Root:string): string;
var
  bi: TBrowseInfo;   //uses ShlObj
  IdList,RootItemIDList: PItemIDList;
  IDesktopFolder:IShellFolder;
  Eaten,Flags:LongWord;
begin
  result := '';
  FillChar(bi, SizeOf(bi), 0);
  bi.hwndOwner := 0;
  bi.lpszTitle := PChar(Title);
  bi.ulFlags := BIF_RETURNONLYFSDIRS + 64; //加了64，显示"新建文件夹"按钮  //设置起始路径
  if Root <> '' then
  begin
    SHGetDesktopFolder(IDesktopFolder);
    IDesktopFolder.ParseDisplayName(Application.Handle, nil,
      POleStr(WideString(Root)), Eaten, RootItemIDList, Flags); //uses ActiveX
    bi.pidlRoot:=RootItemIDList;
  end;  IdList := SHBrowseForFolder(bi);
  if IdList<>nil then
  begin
    SetLength(result, 255);
    SHGetPathFromIDList(IdList, PChar(result));
    result := string(pchar(result));
    if result<>'' then
      if result[Length(result)] <>'\' then
        result := result + '\';
  end;
end;

Answer 1

用带回调函数的SHBrowseForFolder：
function BrowseProc(hWin: THandle; uMsg: Cardinal; lParam: LPARAM; lpData: LPARAM):LRESULT;stdcall;
var
    DefaultDir: PChar;
begin
    DefaultDir := 'C:\Windows'; // 指定一个默认目录
    if uMsg = BFFM_INITIALIZED then
        SendMessage(hWin, BFFM_SETSELECTION, 1, LongInt(DefaultDir));    Result := 0;
end;function SelectPath(const Title: string;Root:string): string;
var
  bi: TBrowseInfo;   //uses ShlObj
  IdList,RootItemIDList: PItemIDList;
  IDesktopFolder:IShellFolder;
  Eaten,Flags:LongWord;
begin
  result := '';
  FillChar(bi, SizeOf(bi), 0);
  bi.hwndOwner := 0;
  bi.lpszTitle := PChar(Title);
  bi.ulFlags := BIF_RETURNONLYFSDIRS + 64; //加了64，显示"新建文件夹"按钮
  bi.lpfn := @BrowseProc;  //设置起始路径
  if Root <> '' then
  begin
    SHGetDesktopFolder(IDesktopFolder);
    IDesktopFolder.ParseDisplayName(Application.Handle, nil,
      POleStr(WideString(Root)), Eaten, RootItemIDList, Flags); //uses ActiveX
    bi.pidlRoot:=RootItemIDList;
  end;  IdList := SHBrowseForFolder(bi);
  if IdList<>nil then
  begin
    SetLength(result, 255);
    SHGetPathFromIDList(IdList, PChar(result));
    result := string(pchar(result));
    if result<>'' then
      if result[Length(result)] <>'\' then
        result := result + '\';
  end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
    SelectPath('请选择一个目录', '');
end;

Answer 2

谢谢楼上的，
再请教一下，如果我想把 'C:\Windows'换成变量，那应该怎么传?

Answer 3

这是改良版，可以带默认目录作参数。function BrowseProc(hWin: THandle; uMsg: Cardinal; lParam: LPARAM; lpData: LPARAM):LRESULT;stdcall;
begin
    if uMsg = BFFM_INITIALIZED then
        SendMessage(hWin, BFFM_SETSELECTION, 1, lpData); // 用传过来的参数作默认路径    Result := 0;
end;function SelectPath(const Title: string;Root:string; DefaultDir: PChar): string;
var
  bi: TBrowseInfo;   //uses ShlObj
  IdList,RootItemIDList: PItemIDList;
  IDesktopFolder:IShellFolder;
  Eaten,Flags:LongWord;
begin
  result := '';
  FillChar(bi, SizeOf(bi), 0);
  bi.hwndOwner := 0;
  bi.lpszTitle := PChar(Title);
  bi.ulFlags := BIF_RETURNONLYFSDIRS + 64; //加了64，显示"新建文件夹"按钮
  bi.lpfn := @BrowseProc;
  bi.lParam := longint(defaultDir); // 重点是增加了这个  //设置起始路径
  if Root <> '' then
  begin
    SHGetDesktopFolder(IDesktopFolder);
    IDesktopFolder.ParseDisplayName(Application.Handle, nil,
      POleStr(WideString(Root)), Eaten, RootItemIDList, Flags); //uses ActiveX
    bi.pidlRoot:=RootItemIDList;
  end;  IdList := SHBrowseForFolder(bi);
  if IdList<>nil then
  begin
    SetLength(result, 255);
    SHGetPathFromIDList(IdList, PChar(result));
    result := string(pchar(result));
    if result<>'' then
      if result[Length(result)] <>'\' then
        result := result + '\';
  end;
end;procedure TForm1.Button1Click(Sender: TObject);
begin
    SelectPath('请选择一个目录', '', 'c:\windows'); // 改装后的函数
end;

Answer 4

uses FileCtrl;SelectDirectory()；不就可以带默认路径的吗？

Answer 5

谢谢两位!
SelectDirectory();原来还有这个函数，也不错!