Показать диалог выбора директории с кнопкой для создания новой

Delphi , Программа и Интерфейс , Диалоги и Фреймы

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

{....}

 uses
   ShlObj, ActiveX;

 {....}


 { 
  This code shows the SelectDirectory dialog with additional expansions: 
  - an edit box, where the user can type the path name, 
  - also files can appear in the list, 
  - a button to create new directories. 


  Dieser Code zeigt den SelectDirectory-Dialog mit zusatzlichen Erweiterungen: 
  - eine Edit-Box, wo der Benutzer den Verzeichnisnamen eingeben kann, 
  - auch Dateien konnen in der Liste angezeigt werden, 
  - eine Schaltflache zum Erstellen neuer Verzeichnisse. 
}

 function AdvSelectDirectory(const Caption: string; const Root: WideString;
   var Directory: string; EditBox: Boolean = False; ShowFiles: Boolean = False;
   AllowCreateDirs: Boolean = True): Boolean;
   // callback function that is called when the dialog has been initialized 
  //or a new directory has been selected 

  // Callback-Funktion, die aufgerufen wird, wenn der Dialog initialisiert oder 
  //ein neues Verzeichnis selektiert wurde 
  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));
       // include the following comment into your code if you want to react on the 
      //event that is called when a new directory has been selected 
      // binde den folgenden Kommentar in deinen Code ein, wenn du auf das Ereignis 
      //reagieren willst, das aufgerufen wird, wenn ein neues Verzeichnis selektiert wurde 
      {BFFM_SELCHANGED: 
      begin 
        SHGetPathFromIDList(PItemIDList(lParam), @PathName); 
        // the directory "PathName" has been selected 
        // das Verzeichnis "PathName" wurde selektiert 
      end;}
     end;
     Result := 0;
   end;
 var
   WindowList: Pointer;
   BrowseInfo: TBrowseInfo;
   Buffer: PChar;
   RootItemIDList, ItemIDList: PItemIDList;
   ShellMalloc: IMalloc;
   IDesktopFolder: IShellFolder;
   Eaten, Flags: LongWord;
 const
   // necessary for some of the additional expansions 
  // notwendig fur einige der zusatzlichen Erweiterungen 
  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);
         // defines how the dialog will appear: 
        // legt fest, wie der Dialog erscheint: 
        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;


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

Это код на Delphi, который демонстрирует диалог выбора папки с дополнительными функциями, такими как поле ввода для указания пути к файлу, отображение списка файлов и кнопка создания новых папок.

Основная функция - AdvSelectDirectory, которая принимает несколько параметров:

• Caption: Заголовок диалога.
• Root: Корневая папка, из которой начать поиск.
• Directory: Переменная для хранения выбранного пути к папке.
• EditBox: Булево значение, указывающее, отображать ли поле ввода для указания пути к файлу. (Значение по умолчанию: False)
• ShowFiles: Булево значение, указывающее, отображать ли список файлов. (Значение по умолчанию: False)
• AllowCreateDirs: Булево значение, указывающее, разрешать ли создавать новые папки. (Значение по умолчанию: True)

Функция использует несколько функций Windows API, таких как ShBrowseForFolder и SHGetPathFromIDList, для взаимодействия с файловой системой.

Вот разбивка кода:

1. Функция AdvSelectDirectory объявлена с семью параметрами.
2. Callback-функция SelectDirCB определена, которая будет вызываться при инициализации диалога или выборе новой папки.
3. Основная часть функции инициализирует несколько переменных и выделяет память для буферов.
4. Она настраивает структуру TBrowseInfo, чтобы указать поведение браузера.
5. Использует ShGetMalloc для выделения памяти для ItemIDList.
6. Если параметр Root указан, она использует SHGetDesktopFolder и ParseDisplayName для получения item ID list для корневой папки.
7. Функция вызывает OleInitialize, чтобы инициализировать библиотеку COM.
8. Она настраивает callback-функцию SelectDirCB, которая будет вызываться при инициализации диалога или выборе новой папки.
9. Если параметр Directory указан, она устанавливает начальную выборку в эту папку.
10. Функция вызывает ShBrowseForFolder с структурой TBrowseInfo и ожидает выбора пользователем папки.
11. После закрытия диалога она освобождает выделившуюся память и возвращает выбранное пути к папке.

Пример кода в конце демонстрирует, как использовать функцию AdvSelectDirectory в Delphi-форме:

• Handler события Button1Click вызывает AdvSelectDirectory с несколькими параметрами.
• Он устанавливает заголовок label-контроля на выбранном пути к папке.

Обратите внимание, что этот код использует некоторые функции Windows API и библиотеки COM, которые могут требовать дополнительной настройки или конфигурации в зависимости от вашего окружения разработки.

В статье описан код на языке Delphi, который показывает диалог выбора директории с функциональностью добавления редактируемой области ввода пути, отображения файлов в списке и кнопки создания новых директорий.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Диалоги и Фреймы ::