Форум программистов
 
О проблемах с регистрацией пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail, а тут можно восстановить пароль.

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail


Закрытая тема
Ваша тема закрыта, почему это могло произойти? Возможно,
Нет наработок или кода, если нужно готовое решение - создайте тему в разделе Фриланс и оплатите работу.
Название темы включает слова - "Помогите", "Нужна помощь", "Срочно", "Пожалуйста".
Название темы слишком короткое или не отражает сути вашего вопроса.
Тема исчерпала себя, помните, один вопрос - одна тема
Прочитайте правила и заново правильно создайте тему.
 
Опции темы
Старый 08.08.2007, 11:23   #1
Kashp
Форумчанин
 
Регистрация: 05.08.2007
Сообщений: 225
По умолчанию Выбор директории

Кидаю на форму Edit, OpenDialog и кнопку.
По событию нажатия кнопки пишу:
Код:
begin
if Opendialog1.Execute then
Edit1.Text:=Opendialog1.FileName;
end;
Вот теперь запускаю и при нажатии кнопки могу выбирать только файлы. Вот как сделать, чтобы я мог выбрать именно папку, чтобы путь к этой папке отобразился в Edit1?
Kashp вне форума
Старый 08.08.2007, 11:34   #2
_SERGEYX_
Участник клуба
 
Аватар для _SERGEYX_
 
Регистрация: 07.07.2007
Сообщений: 1,517
По умолчанию

Нужно юзать не OpenDialog, а какой-нибудь компонент для выбора каталога. Если такого нет - можно самому написать


Код:
uses ShellAPI, ShlObj;
procedure TForm1.Button2Click(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 := 'Выбор каталога:';
  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;
_SERGEYX_ вне форума
Старый 08.08.2007, 11:53   #3
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,840
По умолчанию

Не нужно ничего писать. Все уже написано до нас :


uses Qdialog
...
procedure TForm1.FormCreate(Sender: TObject);
var s:string;
begin
SelectDirectory('Выбери папку','d:\',s);
// s - содержит выбранное.
end;


Ой прощу прощения не Qdialog а FileCtrl.
I'm learning to live...

Последний раз редактировалось Stilet; 06.05.2009 в 08:03.
Stilet вне форума
Старый 08.08.2007, 12:00   #4
Kashp
Форумчанин
 
Регистрация: 05.08.2007
Сообщений: 225
По умолчанию

Большое спасибо!
Kashp вне форума
Старый 30.11.2008, 16:51   #5
FLEX_NST
 
Регистрация: 30.11.2008
Сообщений: 3
По умолчанию

Спасибо огромное! Мне тож сильно помогло! Только вот еще вопросик: Как сделать чтобы было отображение всех дисков?
FLEX_NST вне форума
Старый 30.11.2008, 17:29   #6
Terran
Участник клуба
 
Аватар для Terran
 
Регистрация: 28.11.2007
Сообщений: 1,521
По умолчанию

Цитата:
Сообщение от FLEX_NST Посмотреть сообщение
Спасибо огромное! Мне тож сильно помогло! Только вот еще вопросик: Как сделать чтобы было отображение всех дисков?
Можете использовать компонент DriveComboBox или сделать так:
Код:
Function DriveType(StrDisk: String): String;
Begin
Case
GetDriveType(PChar(StrDisk)) Of
DRIVE_REMOVABLE: DriveType:='Сменный'+'|';
DRIVE_FIXED: DriveType:='Жёсткий диск'+'|';
DRIVE_REMOTE: DriveType:='Remote'+'|';
DRIVE_CDROM: DriveType:='CD-ROM'+'|';
DRIVE_RAMDISK: DriveType:='Ram Диск'+'|';
Else
DriveType:='Неизвестный'+'|';
End;
End;
//--------------------------------------------------//
Function GetDrives: String;
Var
P: Integer;
This, All, C, F, CDrives: String;
Begin
C:=Chr(13);
F:=Chr(0);
SetLength(CDrives,300);
GetLogicalDriveStrings(300,PChar(CDrives));
P:=Pos(F, CDrives);
While P > 0 Do
Begin
This:=Copy(CDrives, 1, P - 1);
If Length(This) <> 3 Then
Break;
This:=UpperCase(This) + ' - ' + DriveType(This);
CDrives:=Copy(CDrives, P + 1,Length(CDrives));
P:=Pos(F, CDrives);
All:=All+This;
End;
GetDrives:=Copy(All, 1, Length(All) - 1);
End;
Procedure TForm1.Button1Click(Sender: TObject);
Begin
Memo1.Lines.Add(GetDrives);
End;
Или так:
Код:
procedure TForm1.Button1Click(Sender: TObject);
var
i, j: integer;
buf: array [0..499] of char;
DrvStr: array [0..9] of char;
LogDrives: set of 0..25;
begin
integer(LogDrives) := GetLogicalDrives;
for i := 0 to 25 do
if (i in LogDrives) then
GetLogicalDriveStrings(1000, buf);
i := 0;
repeat
FillChar(DrvStr, SizeOf(DrvStr), #0);
j := 0;
repeat
DrvStr[j] := buf[i];
inc(j);
inc(i);
until
(buf[i] = #0) or (j > 9);
inc(i);
ListBox1.Items.Add(DrvStr);
until
((buf[i-1] = #0) and (buf[i] = #0)) or (i > 499);
end;
Всегда рад помочь!

Последний раз редактировалось Terran; 30.11.2008 в 17:34.
Terran вне форума
Старый 06.05.2009, 05:29   #7
naps
Новичок
Джуниор
 
Регистрация: 06.05.2009
Сообщений: 1
По умолчанию

Код:
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 := 'Выберите каталог';
   BrowseInfo.lpszTitle := PChar( TitleName );
   BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
   lpItemID := SHBrowseForFolder( BrowseInfo );
   if lpItemId <> nil then
   begin
      SHGetPathFromIDList( lpItemID, TempPath );
      Caption := TempPath;
      GlobalFreePtr( lpItemID );
   end;
end;

Последний раз редактировалось Stilet; 06.05.2009 в 08:03.
naps вне форума
Закрытая тема
Купить рекламу на форуме 20000 рублей в месяц
Опции темы


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Диалог открытия директории Altera Общие вопросы Delphi 13 05.07.2008 11:55
выбор директории Var17 Win Api 5 13.05.2008 12:50
отправка директории kommunist Работа с сетью в Delphi 2 19.01.2008 17:24
Проверка наличия директории SANIOK_AV Общие вопросы Delphi 2 16.01.2008 11:05
Выбрать имя папки из директории Македонский Общие вопросы Delphi 15 29.08.2007 09:48


Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru
Пеллетный котёл Emtas
котлы EMTAS