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

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> помогите с openddialog, как открыть папку в опендиалоге? 
:(
    Опции темы
Departed
Дата 18.3.2008, 16:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет
как сделать чтобы, тыкаешь на папку в опендиалоге и выдается список хранящихся в ней файлов. Т.е. не открывать по 1 или нескольким файлам, а тупо все файлы хранящиеся в папке
PM MAIL   Вверх
Rennigth
Дата 18.3.2008, 16:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 15
Всего: 76
С OpenDialog-ом не получиться. Используй сначала диалог выбора диолога. Для версий делфей
>bds2005 можешь использовать такую функцию(вроде из дркб):
Код

function GetSelectDirectory(AHandle: Cardinal = 0): string;
var
  TitleName : string;
  lpItemID : PItemIDList;
  BrowseInfo : TBrowseInfo;
  DisplayName : array[0..MAX_PATH] of char;
  TempPath : array[0..MAX_PATH] of char;
begin
  Result := '';
  FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
  
  if AHandle = 0 then
  begin
    if Assigned(Application.MainForm) then
      BrowseInfo.hwndOwner := Application.MainForm.Handle;
  end else
    BrowseInfo.hwndOwner := AHandle;

  BrowseInfo.pszDisplayName := @DisplayName;
  TitleName := 'Âûáåðèòå äèðåêòîðèþ';
  BrowseInfo.lpszTitle := PChar(TitleName);
  BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
  lpItemID := SHBrowseForFolder(BrowseInfo);
  if Assigned(lpItemId) then
  begin
    SHGetPathFromIDList(lpItemID, TempPath);
    GlobalFreePtr(lpItemID);
    Result := TempPath;
  end;
end;


Для делфей выше вроде есть уже стандартные диалоги.

Далее при получении директории проходимся по ней FindFirst/FindNext/FindClose.






--------------------
(* Honesta mors turpi vita potior *)
PM MAIL ICQ   Вверх
THandle
  Дата 18.3.2008, 17:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Хранитель Клуба
Group Icon
Награды: 1



Профиль
Группа: Админ
Сообщений: 3639
Регистрация: 31.7.2007
Где: Moscow, Dubai

Репутация: 50
Всего: 372
Вот примерчик, думаю как раз то что и требуется. Выводит по нажатию кнопки имена всех файлов в Memo из выбранного каталога, не заходя в поддиректории.

Код

procedure ListFiles(Dir: string; Strings: TStrings);
var
  rSearchRec: TSearchRec;
begin
  if not Assigned(Strings) then
    Exit;
  Dir := IncludeTrailingBackslash(Dir);
  if FindFirst(Dir + '*.*', faAnyFile, rSearchRec) = 0 then
    repeat
      if ((rSearchRec.Name <> '.') and (rSearchRec.Name <> '..')) then
        if rSearchRec.Attr <> faDirectory  then
          Strings.Add(rSearchRec.Name);
    until FindNext(rSearchRec) <> 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Dir : string;
begin
  SelectDirectory('Вывести имена файлов из каталога:', '', Dir);
  if Dir <> '' then
     ListFiles(Dir, Memo1.Lines);
end;


Добавлено через 24 секунды
ЗЫ: еще в Uses надо добавить FileCTRL.
PM   Вверх
Rennigth
Дата 18.3.2008, 18:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 15
Всего: 76
THandle, где FindClose?  smile 


--------------------
(* Honesta mors turpi vita potior *)
PM MAIL ICQ   Вверх
lukas
Дата 18.3.2008, 18:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 3
Всего: 15
без FindClose не удалишь папку пока не закроешь программу ))  smile 


--------------------
http://code.google.com/p/orionphp/ - opensource скриптовой язык Orion (аналог PHP) для freepascal/delphi.
PM MAIL WWW   Вверх
VICTAR
Дата 18.3.2008, 18:43 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 10
Всего: 80
Цитата

if rSearchRec.Attr <> faDirectory  then

опять двадцать пять  smile 
PM MAIL   Вверх
Rennigth
Дата 18.3.2008, 19:01 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 15
Всего: 76
VICTAR, ты про то что надо так:
Код

(rSearchRec.Attr and faDirectory) = 0

? 
Просто сам тонкостей не помню, кроме этой  smile 


--------------------
(* Honesta mors turpi vita potior *)
PM MAIL ICQ   Вверх
VICTAR
Дата 18.3.2008, 19:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 10
Всего: 80
Rennigth, именно.
За последнюю неделю-две уже раз третий обсуждаем этот момент. 
И как видно все бесполезно... 
PM MAIL   Вверх
THandle
Дата 18.3.2008, 19:49 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Хранитель Клуба
Group Icon
Награды: 1



Профиль
Группа: Админ
Сообщений: 3639
Регистрация: 31.7.2007
Где: Moscow, Dubai

Репутация: 50
Всего: 372
VICTAR, да, сорь. У меня просто в папочке на омпе старый вариант лежит, поэтому он тут и есть. Сча исправлю. smile 


Исправил smile 


Код

procedure ListFiles(Dir: string; Strings: TStrings);
var
  rSearchRec: TSearchRec;
begin
  if not Assigned(Strings) then
    Exit;
  Dir := IncludeTrailingBackslash(Dir);
  if FindFirst(Dir + '*.*', faAnyFile, rSearchRec) = 0 then
    repeat
      if ((rSearchRec.Name <> '.') and (rSearchRec.Name <> '..')) then
        if (rSearchRec.Attr and faDirectory) = 0  then
          Strings.Add(rSearchRec.Name);
    until FindNext(rSearchRec) <> 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
  Dir : string;
begin
  SelectDirectory('Вывести имена файлов из каталога:', '', Dir);
  if Dir <> '' then
     ListFiles(Dir, Memo1.Lines);
end;





Это сообщение отредактировал(а) THandle - 18.3.2008, 19:52
PM   Вверх
VICTAR
Дата 18.3.2008, 20:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 10
Всего: 80
Цитата(THandle @  18.3.2008,  19:49 Найти цитируемый пост)
У меня просто в папочке на омпе старый вариант лежит,

smile  smile 
PM MAIL   Вверх
THandle
Дата 18.3.2008, 20:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Хранитель Клуба
Group Icon
Награды: 1



Профиль
Группа: Админ
Сообщений: 3639
Регистрация: 31.7.2007
Где: Moscow, Dubai

Репутация: 50
Всего: 372
VICTAR, изменил, изменил, не беспокойся smile 


Кстати, вот сейчас эту нашу частообсуждаемую тему в ФАке нашел:
http://forum.vingrad.ru/faq/topic-156479.html

Правда там неплохо было бы подредактировать:

Вместо

Код

if Dir<>'' then if Dir[length(Dir)]<>'\' then Dir:=Dir+'\';  


сделать

Код

Dir := IncludeTrailingBackslash(Dir);



Поднимать такую старую тему из подобного пустяка нет смысла, но может быть кто-нибудь из модераторов подредактирует?
А потом на этот вопрос смело всех посылать в ту тему?
PM   Вверх
Rennigth
Дата 19.3.2008, 10:55 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 15
Всего: 76
Цитата(Rennigth @  18.3.2008,  18:19 Найти цитируемый пост)
THandle, где FindClose? 


Цитата(THandle @  18.3.2008,  19:49 Найти цитируемый пост)
Исправил 


???  smile порчу нашлю!!!  smile  шутка... smile



--------------------
(* Honesta mors turpi vita potior *)
PM MAIL ICQ   Вверх
THandle
Дата 19.3.2008, 14:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Хранитель Клуба
Group Icon
Награды: 1



Профиль
Группа: Админ
Сообщений: 3639
Регистрация: 31.7.2007
Где: Moscow, Dubai

Репутация: 50
Всего: 372
Rennigth, 

Ладно, пусть будет и FindClose, только порчи не надо smile 
Боюсь как бы нас тут не забанили за разведение флуда.

Код

procedure ListFiles(Dir: string; Strings: TStrings);
var
  rSearchRec: TSearchRec;
begin
  if not Assigned(Strings) then
    Exit;
  Dir := IncludeTrailingBackslash(Dir);
  if FindFirst(Dir + '*.*', faAnyFile, rSearchRec) = 0 then
    repeat
      if ((rSearchRec.Name <> '.') and (rSearchRec.Name <> '..')) then
        if (rSearchRec.Attr and faDirectory) = 0  then
          Strings.Add(rSearchRec.Name);
    until FindNext(rSearchRec) <> 0;
  FindClose(rSearchRec); 
end;


Код

procedure TForm1.Button1Click(Sender: TObject);
var
  Dir : string;
begin
  SelectDirectory('Вывести имена файлов из каталога:', '', Dir);
  if Dir <> '' then
     ListFiles(Dir, Memo1.Lines);
end;


Хотя если FindFirst ничего не найдет, не понятно зачем вызывать повторно FindClose. smile 




Это сообщение отредактировал(а) THandle - 19.3.2008, 14:53
PM   Вверх
Rennigth
Дата 19.3.2008, 15:15 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 15
Всего: 76
Цитата(THandle @  19.3.2008,  14:52 Найти цитируемый пост)
Хотя если FindFirst ничего не найдет, не понятно зачем вызывать повторно FindClose. 

А это добрые ребята из борландов о нас так заботяться  smile
Тогда бы в FindNext бы по окончанию поика FindClose сделала... так нееет. Вообщем приходиться FindClose делать всегда, надо это или нет.


--------------------
(* Honesta mors turpi vita potior *)
PM MAIL ICQ   Вверх
Departed
Дата 24.3.2008, 14:23 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет
Всем спасио за советы)
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Для новичков"
SnowyMetalFan
bemsPoseidon
Rrader

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

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

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

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

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

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


 




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


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

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