Unit BrowseFolder;
{$I ..\..\..\Lib\PDFlibDefines.inc}

Interface

Function BrowseForFolder(Const browseTitle: String; Const initialFolder: String = ''; mayCreateNewFolder: Boolean = False): String;

Implementation

Uses
{$IFDEF XE2+}
  Winapi.Windows,
  Vcl.Forms,
  Winapi.ShlObj;

{$ELSE}
  Windows,
  Forms,
  ShlObj;

{$ENDIF}

Var
  lg_StartFolder: String;

  // With later versions of Delphi you may not need these constants.
Const
  BIF_NEWDIALOGSTYLE = $40;
  BIF_NONEWFOLDERBUTTON = $200;

  /// /////////////////////////////////////////////////////////////////////
  // 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.
// mayCreateNewFolder : Flag indicating whether the user can create a
// new folder.
//
// 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 = ''; mayCreateNewFolder: Boolean = False): String;
Var
  browse_info: TBrowseInfo;
  folder: Array [0 .. MAX_PATH] Of Char;
  find_context: PItemIDList;
Begin
  // --------------------------
  // Initialise the structure.
  // --------------------------
  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 not mayCreateNewFolder Then
    browse_info.ulFlags := browse_info.ulFlags or BIF_NONEWFOLDERBUTTON;

  browse_info.hwndOwner := Application.Handle;
  If initialFolder <> '' Then
    browse_info.lpfn := BrowseForFolderCallBack;
  find_context := SHBrowseForFolder(browse_info);
  If Assigned(find_context) Then
  Begin
    If SHGetPathFromIDList(find_context, folder) Then
      Result := folder
    Else
      Result := '';
    GlobalFreePtr(find_context);
  End
  Else
    Result := '';
End;

End.
