Модераторы: Poseidon, Snowy, bems, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> выбор каталога 
:(
    Опции темы
sgentstuff
Дата 7.7.2006, 13:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 116
Регистрация: 13.9.2005

Репутация: нет
Всего: 1
как вывести диалог выбор каталога, далее выбрать каталог и в программе получить этот путь в виде текстовой строки?  
--------------------
Тот, кто ищет миллионы, весьма редко их находит, но тот, кто их не ищет, не находит никогда.  
PM ICQ   Вверх
Romikgy
Дата 7.7.2006, 13:49 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Любитель-программер
****


Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 26
Всего: 146
Народ качайте ДРКБ меньше таких вопросов будет!

Код

uses ShellAPI, ShlObj; 

procedure TForm1.Button1Click(Sender: TObject); 
var 
 TitleName : string;  
 
 lpItemID : PItemIDList;  
 
 BrowseInfo : TBrowseInfo;  
 
 DisplayName : array[0..MAX_PATH] of char;  
 
 TempPath : array[0..MAX_PATH] of char;  
 
  
begin 
 FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);  
 
 BrowseInfo.hwndOwner := Form1.Handle;  
 
 BrowseInfo.pszDisplayName := @DisplayName;  
 
 TitleName := 'Please specify a directory';  
 
 BrowseInfo.lpszTitle := PChar(TitleName);  
 
 BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;  
 
 lpItemID := SHBrowseForFolder(BrowseInfo);  
 
 if lpItemId <> nil then begin  
 
  
 SHGetPathFromIDList(lpItemID, TempPath);  
 
 ShowMessage(TempPath);  
 
 GlobalFreePtr(lpItemID);  
 
  
 end;  
 
  
end; 



Добавлено @ 13:50 
Код

Вариант от Анатолия ([email protected]) 

threadvar myDir: string; 

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

function SelectDirectory(const Caption: string; const Root: WideString; 
var Directory: string): Boolean; 
var 
 WindowList: Pointer;  
 
 BrowseInf!  
 
 o: TBrowseInfo;  
 
 Buffer: PChar;  
 
 RootItemIDList, ItemIDList: PItemIDList;  
 
 ShellMalloc: IMalloc;  
 
 IDesktopFolder: IShellFolder;  
 
 Eaten, Flags: LongWord;  
 
  
begin 
 myDir := Directory;  
 
 Result := False;  
 
 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;  
 
 with BrowseInfo do  
 
 begin  
 
  
 hwndOwner := Application.Handle;  
 
 pidlRoot := RootItemIDList;  
 
 pszDisplayName := Buffer;  
 
 lpfn := @BrowseCallbackProc;  
 
 lParam := Integer(PChar(Directory));  
 
 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;  
 
 Result := ItemIDList <> nil;  
 
 if Result then  
 
 begin  
 
  
 ShGetPathFromIDList(ItemIDList!  
 
 , Buffer);  
 
 ShellMalloc.Free(ItemIDList);  
 
 Directory := Buffer;  
 
  
 end;  
 
 finally  
 
  
 ShellMalloc.Free(Buffer);  
 
  
 end;  
 
 end;  
 
  
end; 

 


--------------------
Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности. 
smile
PM   Вверх
sgentstuff
Дата 7.7.2006, 14:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 116
Регистрация: 13.9.2005

Репутация: нет
Всего: 1
Код

 threadvar myDir: string;


 threadvar - что это? 
--------------------
Тот, кто ищет миллионы, весьма редко их находит, но тот, кто их не ищет, не находит никогда.  
PM ICQ   Вверх
Alexeis
Дата 7.7.2006, 14:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459
А еще можно скачать соответствующий компонент с torry.net - там точно есть!

Добавлено @ 14:06 
Цитата(sgentstuff @  7.7.2006,  14:04 Найти цитируемый пост)
threadvar

потокобезопасная переменная

Добавлено @ 14:07 
вот и ссылочкаhttp://www.torry.net/vcl/dialogs/stddialogs/amdirdlg.zip

Добавлено @ 14:11 
И еще 
http://www.torry.ne[url=http://www.torry.n.../jmfldbrwsr.zip
http://www.torry.net/vcl/dialogs/stddialogs/brwsfldr.zip
http://www.torry.net/vcl/dialogs/stddialogs/browsedr.zip   

Это сообщение отредактировал(а) alexeis1 - 7.7.2006, 14:15


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Matematik
Дата 7.7.2006, 14:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 17
Всего: 50
SelectDirectory() из FileCtrl.pas
В хелпе пример есть  

Это сообщение отредактировал(а) Matematik - 7.7.2006, 14:42
PM MAIL WWW ICQ   Вверх
Sunvas
Дата 8.7.2006, 05:34 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Соль и сахар
****


Профиль
Группа: Участник
Сообщений: 3388
Регистрация: 12.3.2006
Где: Тосно

Репутация: 28
Всего: 89
Все просто:
Код

uses ShlObj; 

{....}

procedure CallBack(wnd: hWnd; uMsg: UINT; lParam, lpData: LParam) stdcall; 
begin 
  SendMessage(wnd, BFFM_ENABLEOK, 0, 1); 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
var 
  bi: TBrowseInfo; 
  s: PChar; 
  PIDL, ResPIDL: PItemIDList; 
begin 
  SHGetSpecialFolderLocation(Form1.Handle, CSIDL_DESKTOP, PIDL); 
  s := StrAlloc(128); 
  bi.hwndOwner := Form1.Handle; 
  bi.pszDisplayName := s; 
  bi.lpszTitle := 'Выбор прапки'; 
  bi.pidlRoot := PIDL; 
  bi.lpfn := addr(CallBack); 
{bi.ulFlags флаги, которые задают режим отображения диалога:
  BIF_BROWSEFORCOMPUTER - Возвратить только компьютеры. Если пользователь выбрал что-то отличное от компьютеров, то кнопка OK останется серой.
  BIF_BROWSEFORPRINTER - Возвратить только принтеры. Если пользователь выбрал что-
то отличное от принтеров, то кнопка OK останется серой.
  BIF_RETURNONLYFSDIRS - Возвратить только папки файловой системы. Если пользователь выберет папки, которые не являются частью файловой системы, то кнопка OK останется серой. Это необходимо для того если ваша программа не работает с виртуальными папками вроде "Панель управления".
  BIF_BROWSEINCLUDEFILES - Диалог просмотра будет отображать файлы вместе с директориями.
  BIF_DONTGOBELOWDOMAIN - Не включать сетевые папки Доменного уровня ниже, чем в TreeView контроле.
  BIF_RETURNFSANCESTORS - В качестве выбора допустимы только объекты, представленные в файловой системе.
  BIF_STATUSTEXT - Включает область статуса в блок диалога. Функция может установить текст посылая сообщения блоку диалога.
  BIF_EDITBOX - В диалоговом окне будет присутствовать строка редактирования, таким образом пользователь может набрать имя элемента.
  BIF_VALIDATE - Если пользователь введёт неверное имя в строке редактирования, то диалоговое окно вызовет функцию обратного вызова приложения по сообщению BFFM_VALIDATEFAILED.}
  ResPidl := SHBrowseForFolder(BI); 
  SHGetPathFromIDList(ResPidl, s); 
  Form1.Caption := s; 
end;
 


--------------------
Воспитывая детей по своему образу и подобию, родители почему-то надеются, что они будут лучше их.
PM MAIL   Вверх
Akella
Дата 10.7.2006, 08:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Творец
****


Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329
еще вариант

Код

uses ... ShlObj, ...

...



function TfmOptions.Selectdir(const str: string): string;

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

var
 TitleName : string;
 lpItemID : PItemIDList;
 BrowseInfo : TBrowseInfo;
 DisplayName : array[0..MAX_PATH] of char;
 TempPath : array[0..MAX_PATH] of char;
 begin
   Result:='';
   sx:=str;
   FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
   BrowseInfo.hwndOwner := Application.Handle;
   BrowseInfo.pszDisplayName := @DisplayName;
   TitleName := 'Выберите папку...';
   BrowseInfo.lpszTitle := PChar(TitleName);
   BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS or $0040;// or BIF_EDITBOX or BIF_STATUSTEXT;
   BrowseInfo.lpfn := @BrowseCallbackProc;
   lpItemID := SHBrowseForFolder(BrowseInfo);
   if lpItemId <> nil then begin
   SHGetPathFromIDList(lpItemID, TempPath);
   Result:=StrPas(TempPath);
   GlobalFreePtr(lpItemID);
 end;
end;



Добавлено @ 08:50 
Sunvas, вопрос в тему относительно флагов: какой флаг отвечает за кнопку "Создать папку"? Хочу дать возможность пользователям создавать папки. 
PM MAIL   Вверх
Romikgy
Дата 10.7.2006, 10:00 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Любитель-программер
****


Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 26
Всего: 146
Цитата(Akella @  10.7.2006,  07:38 Найти цитируемый пост)
 вопрос в тему относительно флагов: какой флаг отвечает за кнопку "Создать папку"? Хочу дать возможность пользователям создавать папки. 

http://kpolyakov.by.ru/pr_del.htm
Код

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


--------------------
Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности. 
smile
PM   Вверх
Akella
Дата 10.7.2006, 10:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Творец
****


Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329
Romikgy, сам-то посмотрел пример? там сделано через отдельную кнопку на своей форме (CreateDirectory), а меня интерисует флаг, который отвечает за кнопку "Сосздать папку" непосредственно на форме выпора папки. 
PM MAIL   Вверх
Romikgy
Дата 10.7.2006, 10:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Любитель-программер
****


Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 26
Всего: 146
Цитата(Akella @  10.7.2006,  09:06 Найти цитируемый пост)
сам-то посмотрел пример?

смотрел, и имхо там 
Цитата(Akella @  10.7.2006,  09:06 Найти цитируемый пост)
там сделано через отдельную кнопку на своей форме

не на своей форме а на форме броузера
Код

BFFM_INITIALIZED: begin
        CreateBrowseWindow(Wnd);

используется Wnd которое приходит после вызова ShBrowseForFolder в
Код

function BrowseCallbackProc( Wnd : THandle; uMsg : UINT;
                             lParam : Integer; lpData : Pointer ) : Integer; stdcall;

Цитата(Akella @  10.7.2006,  09:06 Найти цитируемый пост)
интерисует флаг,

я лично не нашел даже на сайте мелкомягких smile
мож те более удача улыбнется 


--------------------
Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности. 
smile
PM   Вверх
Snowy
Дата 10.7.2006, 12:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484
Этот флаг зовётся BIF_NEWDIALOGSTYLE
Цитата
Use the new user interface. Setting this flag provides the user with a larger dialog box that can be resized. The dialog box has several new capabilities including: drag-and-drop capability within the dialog box, reordering, shortcut menus, new folders, delete, and other shortcut menu commands. To use this flag, you must call OleInitialize or CoInitialize before calling SHBrowseForFolder

Не забыть вызвать CoInitialize перед использованием! 
PM MAIL   Вверх
Akella
Дата 10.7.2006, 12:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Творец
****


Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329
Вот что Snowy нашёл
Цитата

BIF_NEWDIALOGSTYLE
Version 5.0. Use the new user interface. Setting this flag provides the user with a larger dialog box that can be resized. The dialog box has several new capabilities including: drag-and-drop capability within the dialog box, reordering, shortcut menus, new folders, delete, and other shortcut menu commands. To use this flag, you must call OleInitialize or CoInitialize before calling SHBrowseForFolder.

BIF_NONEWFOLDERBUTTON
Version 6.0. Do not include the New Folder button in the browse dialog box.
 
PM MAIL   Вверх
Sunvas
Дата 11.7.2006, 01:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Соль и сахар
****


Профиль
Группа: Участник
Сообщений: 3388
Регистрация: 12.3.2006
Где: Тосно

Репутация: 28
Всего: 89
Цитата(Akella @  10.7.2006,  08:38 Найти цитируемый пост)
Sunvas, вопрос в тему относительно флагов: какой флаг отвечает за кнопку "Создать папку"? Хочу дать возможность пользователям создавать папки. 

Код

bi.ulFlags:=BIF_NEWDIALOGSTYLE;

Просто забыл дописать.. 


--------------------
Воспитывая детей по своему образу и подобию, родители почему-то надеются, что они будут лучше их.
PM MAIL   Вверх
WaReZMEN
Дата 22.1.2009, 15:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 683
Регистрация: 9.6.2006
Где: Россия, Санкт-Пет ербург

Репутация: нет
Всего: 3
А как сделать чтоб запоминала последний выбраны каталог?  smile 
PM MAIL ICQ   Вверх
Rrader
  Дата 22.1.2009, 17:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Inspired =)
***


Профиль
Группа: Экс. модератор
Сообщений: 1535
Регистрация: 7.5.2005

Репутация: 70
Всего: 191
По сообщению BFFM_SELCHANGED запоминать папку, а затем перед запуском диалога в pidlRoot эту папку указывать


--------------------
Let's do this quickly!
Rest in peace, Vit!
PM MAIL Skype   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0666 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.