Sunday, 14 March 2010

Showing the folder dialog in Delphi

Some time ago, I published one post showing the way we can open the folder dialog with Delphi. But this snippet of code doesn't work for Delphi 2010. Then, I found this little code that allows you to open the folder dialog with no problems.

unit folderDialog;

interface

uses
    SysUtils, ShlObj, Windows, ActiveX, Forms;

function GetFolderDialog2(const ACaption: string; out ADirectory: string): boolean;
function BrowseForFolder: string;

implementation

function BrowseForFolder: string;
begin
  GetFolderDialog('Add directory:', Result);
end;

function GetFolderDialog(const ACaption: string; out ADirectory: string): boolean;
const
  BIF_NEWDIALOGSTYLE       = $0040;
  BIF_NONEWFOLDERBUTTON    = $0200;
  BIF_USENEWUI             = BIF_NEWDIALOGSTYLE or BIF_EDITBOX;
var
  pWindowList: Pointer;
  tbsBrowseInfo: TBrowseInfo;
  pBuffer: PChar;
  iOldErrorMode: cardinal;
  pIemIDList: PItemIDList;
  pShellMalloc: IMalloc;
begin
  CoInitialize(nil);
  try
    Result := false;
    ADirectory := '';
    FillChar(tbsBrowseInfo, sizeof(tbsBrowseInfo), 0);
    if (ShGetMalloc(pShellMalloc) = S_OK) and Assigned(pShellMalloc) then
    begin
      pBuffer := pShellMalloc.Alloc(MAX_PATH);
      try
        with tbsBrowseInfo do
        begin
          hwndOwner := Application.Handle;
          pidlRoot := nil;
          pszDisplayName := pBuffer;
          lpszTitle := PChar(ACaption);
          ulFlags := BIF_USENEWUI or BIF_RETURNONLYFSDIRS or BIF_NONEWFOLDERBUTTON;
          lParam := 0;
        end;
        pWindowList := DisableTaskWindows(0);
        iOldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
        try
          pIemIDList := ShBrowseForFolder(tbsBrowseInfo);
        finally
          SetErrorMode(iOldErrorMode);
          EnableTaskWindows(pWindowList);
        end;
        Result := Assigned(pIemIDList);
        if Result then
        begin
          ShGetPathFromIDList(pIemIDList, pBuffer);
          pShellMalloc.Free(pIemIDList);
          ADirectory := pBuffer;
        end;
      finally
        pShellMalloc.Free(pBuffer);
      end;
    end;
  finally
    CoUninitialize;
  end;
end;

end.

Now we can see the result after the execution of the code:


0 comments:

Post a Comment