Mostrar el Dialogo de carpetas

Con delphi no tenemos ningún dialogo para mostrar solo las carpetas. Disponemos de los componentes TDialog que nos permiten abrir ficheros, seleccionarlos o abrir otros tipos de dialogo como los de colores, fuentes, etc. Para cargar solo el dialogo de carpetas, lo tenemos que hacer como siempre se ha hecho, utilizando la Win32 API Shell objects Interface Unit (ShlObj). En ésta unit encontraremos toda la información para ejecutar nuestro dialogo. Aquí os dejo el código fuente sacado de Scalabium Software y unas imágenes de muestra del dialogo.

Con el siguiente código fuente, obtendremos el dialogo mostrado a continuación:

uses
    SysUtils, ShlObj;

function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam: LPARAM; lpData: LPARAM): Integer; stdcall;
begin
    if (uMsg = BFFM_INITIALIZED) then
        SendMessage(hwnd, BFFM_SETSELECTION, 1, lpData);
    BrowseCallbackProc := 0;
end;

function GetFolderDialog(Handle: Integer; Caption: string; var strFolder: string): Boolean;
const
    BIF_STATUSTEXT = $0004;
    BIF_NEWDIALOGSTYLE = $0040;
    BIF_RETURNONLYFSDIRS = $0080;
    BIF_SHAREABLE = $0100;
    BIF_USENEWUI = BIF_EDITBOX or BIF_NEWDIALOGSTYLE;
var
    BrowseInfo: TBrowseInfo;
    ItemIDList: PItemIDList;
    JtemIDList: PItemIDList;
    Path: PAnsiChar;
begin
    Result := False;
    Path := StrAlloc(MAX_PATH);
    SHGetSpecialFolderLocation(Handle, CSIDL_DRIVES, JtemIDList);
    with BrowseInfo do
    begin
        hwndOwner := GetActiveWindow;
        pidlRoot := JtemIDList;
        SHGetSpecialFolderLocation(hwndOwner, CSIDL_DRIVES, JtemIDList);
        pszDisplayName := StrAlloc(MAX_PATH);
        lpszTitle := PChar(Caption);
        lpfn := @BrowseCallbackProc;
        lParam := LongInt(PChar(strFolder));
    end;
    ItemIDList := SHBrowseForFolder(BrowseInfo);
    if (ItemIDList <> nil) then
        if SHGetPathFromIDList(ItemIDList, Path) then
        begin
            strFolder := Path;
            Result := True
       end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    s: string;
begin
    s := 'C:\';
    if GetFolderDialog(Application.Handle, 'Select a folder', s) then
        Edit1.text := s;
end;