Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Компоненты и классы
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 16.07.2007, 06:23
Lie Lie вне форума
Прохожий
 
Регистрация: 21.04.2007
Сообщения: 10
Репутация: 10
По умолчанию OpenDialog

Как с посощью OpenDialog или какого-нибудь другого компонента (только не DirectoryListBox1) выбирать и открывать только директории.
Чтобы FileName был допустим "C:\Games"
Ответить с цитированием
  #2  
Старый 16.07.2007, 11:25
Аватар для 4kusNick
4kusNick 4kusNick вне форума
Местный
 
Регистрация: 06.09.2006
Адрес: Россия, Санкт-Петербург
Сообщения: 444
Репутация: 550
По умолчанию

В uses добавь ActiveX и ShlObj, ComObj (или один из этих модулей, я просто не помню точно...)
Код:
// функция показа диалога для выбора папки
function AdvBrowseDirectory(sCaption: String; wsRoot: WideString; var sDirectory: String; bEditBox: Boolean = False; bShowFiles: Boolean = False; bAllowCreateDirs: Boolean = True; bRootIsMyComp: Boolean = False): Boolean;

  // callback функция, которая вызывается при инициализации диалога
  // или когда создается новая папка

  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));
      // включите этот код, если хотите реагировать на выбор новой папки
      {BFFM_SELCHANGED: 
      begin
        SHGetPathFromIDList(PItemIDList(lParam), @PathName); 
        // папка "PathName" была выбрана
      end;}
     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(sDirectory) then sDirectory := '';
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
  begin
    Buffer := ShellMalloc.Alloc(MAX_PATH);
    try
      RootItemIDList := nil;
      if wsRoot <> '' then
      begin
        SHGetDesktopFolder(IDesktopFolder);
        IDesktopFolder.ParseDisplayName(Application.Handle, nil,
        POleStr(wsRoot), Eaten, RootItemIDList, Flags);
			end
			else
			begin

				if bRootIsMyComp then
					SHGetSpecialFolderLocation(0, CSIDL_DRIVES, RootItemIDList);

			end;
      OleInitialize(nil);
      with BrowseInfo do
      begin
        hwndOwner := Application.Handle;
				pidlRoot := RootItemIDList;
        pszDisplayName := Buffer;
				lpszTitle := PChar(sCaption);
        // определяет то, как диалог будет появляться:
        ulFlags :=
          BIF_RETURNONLYFSDIRS or
          BIF_USENEWUI or
					BIF_EDITBOX * Ord(bEditBox) or
					BIF_BROWSEINCLUDEFILES * Ord(bShowFiles) or
					BIF_NOCREATEDIRS * Ord(not bAllowCreateDirs);
        lpfn    := @SelectDirCB;
        if sDirectory <> '' then lParam := Integer(PChar(sDirectory));
      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);
        sDirectory := Buffer;
      end;
    finally
      ShellMalloc.Free(Buffer);
    end;
  end;
end;

Пример использования:
Код:
//...
var
  sSelectedDir: String;
//...
begin
//...
  AdvBrowseDirectory('Выбор папки с файлами','',sSelectedDir);
  // теперь в sSelectedDir у нас выбранная папка
//...
end;
__________________
THE CRACKER IS OUT THERE

Последний раз редактировалось 4kusNick, 16.07.2007 в 11:28.
Ответить с цитированием
  #3  
Старый 16.07.2007, 14:21
Аватар для <<D>>
<<D>> <<D>> вне форума
Активный
 
Регистрация: 06.05.2007
Адрес: ГДЕ ТО В СОЛНЕЧНОЙ СИСТЕМЕ
Сообщения: 207
Репутация: 15
Смех

Может быть, я ошибаюсь, но, по-моему, так легче:

Uses ...FileCtrl;

...

var
S: string;
begin
S := '';
if SelectDirectory('Select Directory', '', S) then
path:=s;
end;
__________________
Кому я должен - всем прощаю!!!!
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 00:55.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter