function BrowseDir( hOwner: HWND; out SResultDir: STring; const STitle: String = 'Выберите директорию'; const SDefaultDir: String = '' ): Boolean;
var
  lpbi: TBROWSEINFO;
  il: PItemIDList;
  Buffer: Array[0..MAX_PATH] of Char;
begin
  Result := False;
  FillChar( lpbi, sizeof( lpbi ), 0 );
  lpbi.hwndOwner := hOwner;
  lpbi.lpszTitle := LPSTR( STitle );
  lpbi.ulFlags := BIF_RETURNONLYFSDIRS;
  lpbi.pszDisplayName := StrAlloc(MAX_PATH);
  if SDefaultDir <> '' then begin
    lpbi.lParam := LPARAM( PChar( SDefaultDir ) );
    lpbi.lpfn := @BrowseCallbackProc;
  end;

  il := SHBrowseForFolder( lpbi );
  if Assigned( il ) then begin
    if ShGetPathFromIDList( il, @Buffer ) then begin
      SResultDir := String( Buffer );
      Result := True;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  S: String;
begin
  if BrowseDir( Handle, S, 'select dir', 'D:\Downloads' ) then
    Caption := S;
end;

function BrowseCallbackProc(hWindow: HWND; uMsg: Cardinal; lParam, lpData: Integer): Integer; stdcall;
begin
  Result := 0;
  if uMsg = BFFM_INITIALIZED then
    SendMessage(hWindow, BFFM_SETSELECTION, 1, lpData);
end;