Диалог выбора директории с кнопкой "Создать папку"

[artemavd]

Добрый вечер! Какая функция вызывает данный диалог?:

[raxp]

эм, юзай shlobj и drkb...

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

function TForm1.SelectDirPlus(hWnd: HWND; const Caption: string;
  const Root: WideString): String;
var
  WindowList: Pointer;
  BrowseInfo : TBrowseInfo;
  Buffer: PChar;
  RootItemIDList, ItemIDList: PItemIDList;
  ShellMalloc: IMalloc;
  IDesktopFolder: IShellFolder;
  Eaten, Flags: LongWord;
  Cmd: Boolean;
begin
   FillChar( BrowseInfo, SizeOf( BrowseInfo ), 0 );
   if ( ShGetMalloc( ShellMalloc ) = S_OK ) and ( ShellMalloc <> nil ) then
   begin
      Buffer := ShellMalloc.Alloc( MAX_PATH );
      try
         RootItemIDList := nil;
         if Root <> '' then
         begin
            SHGetDesktopFolder( IDesktopFolder );
            IDesktopFolder.ParseDisplayName( hWnd, nil,
            POleStr( Root ), Eaten, RootItemIDList, Flags );
         end;
         with BrowseInfo do
         begin
            hwndOwner := hWnd;
            pidlRoot := RootItemIDList;
            pszDisplayName := Buffer;
            lpfn := @BrowseCallbackProc;
            lpszTitle := PChar( Caption );
            ulFlags := BIF_RETURNONLYFSDIRS or $0040 or BIF_EDITBOX or BIF_STATUSTEXT;
         end;
         WindowList := DisableTaskWindows( 0 );
         try
           ItemIDList := ShBrowseForFolder( BrowseInfo );
         finally
            EnableTaskWindows( WindowList );
         end;
         Cmd :=  ItemIDList <> nil;
         if Cmd then
         begin
            ShGetPathFromIDList( ItemIDList, Buffer );
            ShellMalloc.Free( ItemIDList );
            Result:= Buffer;
         end;
      finally
         ShellMalloc.Free( Buffer );
      end;
   end;
end;

 ...
 // использование
 SelectDirPlus( Handle, 'Выберите каталог', '' )

[Sanprof]

Не знаю кто написал этот компонент, но мне его тоже дали на форуме, я его успешно юзаю
DirSelected.rar

[artemavd]

raxp, говорит, что "[Error] MAIN.PAS(1608): Undeclared identifier: 'IMalloc'"

function TForm1.SelectDirPlus(hWnd: HWND; const Caption: string;
  const Root: WideString): String;
var
  WindowList: Pointer;
  BrowseInfo : TBrowseInfo;
  Buffer: PChar;
  RootItemIDList, ItemIDList: PItemIDList;
  ShellMalloc: IMalloc;
  IDesktopFolder: IShellFolder;
  Eaten, Flags: LongWord;
  Cmd: Boolean;
begin
   FillChar( BrowseInfo, SizeOf( BrowseInfo ), 0 );
   if ( ShGetMalloc( ShellMalloc ) = S_OK ) and ( ShellMalloc <> nil ) then
   begin
      Buffer := ShellMalloc.Alloc( MAX_PATH );
      try
         RootItemIDList := nil;
         if Root <> '' then
         begin
            SHGetDesktopFolder( IDesktopFolder );
            IDesktopFolder.ParseDisplayName( hWnd, nil,
            POleStr( Root ), Eaten, RootItemIDList, Flags );
         end;
         with BrowseInfo do
         begin
            hwndOwner := hWnd;
            pidlRoot := RootItemIDList;
            pszDisplayName := Buffer;
            lpfn := @BrowseCallbackProc;
            lpszTitle := PChar( Caption );
            ulFlags := BIF_RETURNONLYFSDIRS or $0040 or BIF_EDITBOX or BIF_STATUSTEXT;
         end;
         WindowList := DisableTaskWindows( 0 );
         try
           ItemIDList := ShBrowseForFolder( BrowseInfo );
         finally
            EnableTaskWindows( WindowList );
         end;
         Cmd :=  ItemIDList <> nil;
         if Cmd then
         begin
            ShGetPathFromIDList( ItemIDList, Buffer );
            ShellMalloc.Free( ItemIDList );
            Result:= Buffer;
         end;
      finally
         ShellMalloc.Free( Buffer );
      end;
   end;
end;

Sanprof, это компонент для Delphi 2009, а у меня Delphi 7

[Stilet]

artemavd

Запомни метод: Если ты не знаешь что за класс но точно уверен что он описан где-то в генофонде Делфи, запускай поиск по содержимому PAS файлов в папке и подпапках. где лежит делфи, и тогда ты увидишь что интерфейс этот описан в ShellCtrls.pas

P.S. ОЙ! Не то вставилось - он лежит в ActiveX

[artemavd]

Вопрос так и остался нерешеным....

[Marsel737]

artemavd, так тебе же уже Stilet ответил, пропиши в uses ActiveX

[psycho-coder]

Есть компонент TShellTreeView на закладке Samples
и тут

[_SERGEYX_]

Почему нерешенным?
Артем, добавь в uses shlobj, ActiveX и все будет работать. Я проверил.
Вот еще такой вариант

uses
   ShlObj, ActiveX;


function AdvSelectDirectory(const Caption: string; const Root: WideString;
  var Directory: string; EditBox: Boolean = False; ShowFiles: Boolean = False;
  AllowCreateDirs: Boolean = True): Boolean;
  function SelectDirCB(Wnd: HWND; uMsg: UINT; lParam, lpData: lParam): Integer;
    stdcall;
  var
    PathName: array[0..MAX_PATH] of Char;
  begin
    case uMsg of
      BFFM_INITIALIZED: SendMessage(Wnd, BFFM_SETSELECTION, Ord(True), Integer(lpData));
    end;
    Result := 0;
  end;
var
  WindowList: Pointer;
  BrowseInfo: TBrowseInfo;
  Buffer: PChar;
  RootItemIDList, ItemIDList: PItemIDList;
  ShellMalloc: IMalloc;
  IDesktopFolder: IShellFolder;
  Eaten, Flags: LongWord;
const
  BIF_USENEWUI = $0040;
  BIF_NOCREATEDIRS = $0200;
begin
  Result := False;
  if not DirectoryExists(Directory) then
    Directory := '';
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
  begin
    Buffer := ShellMalloc.Alloc(MAX_PATH);
    try
      RootItemIDList := nil;
      if Root <> '' then
      begin
        SHGetDesktopFolder(IDesktopFolder);
        IDesktopFolder.ParseDisplayName(Application.Handle, nil,
          POleStr(Root), Eaten, RootItemIDList, Flags);
      end;
      OleInitialize(nil);
      with BrowseInfo do
      begin
        hwndOwner := Application.Handle;
        pidlRoot := RootItemIDList;
        pszDisplayName := Buffer;
        lpszTitle := PChar(Caption);
        ulFlags := BIF_RETURNONLYFSDIRS or BIF_USENEWUI or
          BIF_EDITBOX * Ord(EditBox) or BIF_BROWSEINCLUDEFILES * Ord(ShowFiles) or
          BIF_NOCREATEDIRS * Ord(not AllowCreateDirs);
        lpfn := @SelectDirCB;
        if Directory <> '' then
          lParam := Integer(PChar(Directory));
      end;
      WindowList := DisableTaskWindows(0);
      try
        ItemIDList := ShBrowseForFolder(BrowseInfo);
      finally
        EnableTaskWindows(WindowList);
      end;
      Result := ItemIDList <> nil;
      if Result then
      begin
        ShGetPathFromIDList(ItemIDList, Buffer);
        ShellMalloc.Free(ItemIDList);
        Directory := Buffer;
      end;
    finally
      ShellMalloc.Free(Buffer);
    end;
  end;
end;

procedure TForm1.RzBitBtn2Click(Sender: TObject);
var dir: string;
begin
  AdvSelectDirectory('Caption', 'c:\', dir, False, False, True);
  // Label1.Caption := dir;
end;

Тоже работает. Проверил