K210.ORG

uses

  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;

procedure TForm1.Button1Click(Sender: TObject);

var

  s: string;

begin

  if GetFolderDialog(handle, 'Select folder', s) then showmessage(s);

end;