Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

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

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

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 25.11.2019, 10:48   #1
NNK_RTR
Пользователь
 
Регистрация: 14.08.2019
Сообщений: 16
По умолчанию Выбор папки

На панели инструментов расположена кнопка с выпадающим списком:
- 'Открыть папку (только эту папку)'
- 'Открыть папку (включая подпапки)'
Если пользователь выбрал 1-опцию, то рисунок на самой кнопке ImageIndex:=0, если вторую, то ImageIndex:=1. (Выбор запоминается в ini-файле).
Щелчок по самой кнопке или по любой из опций, вызывает диалог выбора папки. Вот такой:
Цитата:
//===========================
// Процедура используется в диалоге выбора папки
procedure CallBack(wnd: hWnd; uMsg: UINT; lParam, lpData: LParam) stdcall;
begin
SendMessage(wnd, BFFM_ENABLEOK, 0, 1);
end;
//--------------------------------------------------------- Диалог выбора папки
function R_OpFold: PChar;
var
bi: TBrowseInfo;
Ps: PChar;
PIDL, ResPIDL: PItemIDList;
begin
SHGetSpecialFolderLocation(F_VandS. Handle, CSIDL_DRIVES, PIDL);
Ps := StrAlloc(256);
bi.hwndOwner := F_VandS.Handle;
bi.pszDisplayName := Ps;
bi.lpszTitle := 'Выбор папки';
bi.pidlRoot := PIDL;
bi.lpfn := addr(CallBack);
ResPidl := SHBrowseForFolder(BI);
SHGetPathFromIDList(ResPidl, Ps);
Result := Ps;
end;
//===========================
Все работает, но через раз

bandicam 2019-11-25 10-08-25-913.png

bandicam 2019-11-25 10-10-25-233.png

bandicam 2019-11-25 10-12-55-995.png

Если первые два позволяют выбрать нужную папку, то третий - нет.
Как бороться с этой бедой? Что посоветуете?

Обычно, после подобных вопросов требуют (просят) выложить весь код. Хотя я и не вижу смысла...
Код:
// Восстанавливаем настройки
procedure TF_VandS.FormCreate(Sender: TObject);
begin
 if ArInit[0]=1 then
 begin
  ToolButton1.ImageIndex:=1;
  ToolButton1.Hint:='Открыть папку (только эту папку)';
 end
  else
 begin
  ToolButton1.ImageIndex:=0;
  ToolButton1.Hint:='Открыть папку (включая подпапки)';
 end;
Код:
//Щелчок по самой кнопке
procedure TF_VandS.ToolButton1Click(Sender: TObject);
begin
 if ArInit[0]=0 then ShowMessage(
  'Ошибка. Попробуйте перезапустить приложение');
 if LS2<>NIL then LS2.Clear else LS2:=TStringList.Create;
 if ArInit[0]=1 then Routines.R_SearhOwer(Routines.R_OpFold);
 if ArInit[0]=2 then Routines.R_SearhIns(Routines.R_OpFold);
 if LS2.Count>0 then
 Routines.R_LoadImage(LS2[0]);
end;
Код:
//Щелчок по первой опции
procedure TF_VandS.N1Click(Sender: TObject);
begin
ArInit[0]:=1;
ToolButton1.ImageIndex:=1;
ToolButton1.Hint:='Открыть папку (только эту папку)';
if LS2<>NIL then LS2.Clear else LS2:=TStringList.Create;
Routines.R_SearhOwer(Routines.R_OpFold);
if LS2.Count>0 then
     Routines.R_LoadImage(LS2[0]);
end;
Код:
//Щелчок по второй опции
procedure TF_VandS.N2Click(Sender: TObject);
begin
 ArInit[0]:=2;
 ToolButton1.ImageIndex:=0;
 ToolButton1.Hint:='Открыть папку (включая подпапки)';
 if LS2<>NIL then LS2.Clear else LS2:=TStringList.Create;
 Routines.R_SearhIns(Routines.R_OpFold);
 if LS2.Count>0 then
      Routines.R_LoadImage(LS2[0]);
end;
//Сохранение настроек
Код:
procedure TF_VandS.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  R_IfClose;
end;
Код:
// Выход из программы
procedure R_IfClose;
var
 FSet:File of byte;
 FName:String;
 i:integer;
begin
 FName:=ExtractFilePath(Application.ExeName)+'Private\Init.ini';
 if FileExists(FName) then
  begin
   AssignFile(FSet,FName);
   Reset(FSet);
   for I := 0 to 9 do
     Write(FSet,ArInit[i]);
   CloseFile(FSet);
  end;
 if LS1<>NIL then LS1.Free;
 if LS2<>NIL then LS2.Free;
end;
С уважением, Николай
NNK_RTR вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

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

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Выбор домашней папки пользователя в IdFTPServer noname_06 Общие вопросы Delphi 2 14.06.2014 22:16
Как сделать выбор нескольких файлов из папки lioon Microsoft Office Excel 3 31.10.2013 11:35
Диалог выбор папки DSK Общие вопросы Delphi 1 08.06.2011 17:01
Случайный выбор с папки Marsik Помощь студентам 2 15.12.2007 19:04
Выбор папки UnD)eaD)Snake Общие вопросы Delphi 10 22.08.2007 12:05