Title: Display a dialog for folder selection
Question: How to select a folder?
Answer:
Yesterday I posted how to display standard dialog for files (open/save). Today I want to show how you may use stamndard dialog when user must select a folder/directory.
Use the next function:
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);
{ return display name of item selected }
pszDisplayName := StrAlloc(MAX_PATH);
{ set the title of dialog }
lpszTitle := PChar(Caption);//'Select the folder';
{ flags that control the return stuff }
// ulFlags := ulFlags or BIF_NEWDIALOGSTYLE or BIF_RETURNONLYFSDIRS;
// ulFlags := ulFlags or BIF_RETURNONLYFSDIRS;
lpfn := @BrowseCallbackProc;
{ extra info that's passed back in callbacks }
lParam := LongInt(PChar(strFolder));
end;
ItemIDList := SHBrowseForFolder(BrowseInfo);
if (ItemIDList nil) then
if SHGetPathFromIDList(ItemIDList, Path) then
begin
strFolder := Path;
Result := True
end;
end;
For example,
s := 'c:\Arch';
if GetFolderDialog(Application.Handle, 'Select a folder', s) then
ShowMessage('User selected this folder: ' + s)