|  | 
 
 | 
| 
 | |||||||
| Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны | 
|  | Опции темы | Поиск в этой теме | Опции просмотра | 
| 
			 
			#1  
			
			
			
			
		 | ||||
| 
 | ||||
|  Как открыть системный диалог "выбор папки" Как вызвать этот диалог? в Win7 он выглядит так:  Функции типа: Код: procedure TForm1.Button4Click(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(String(TempPath));
    GlobalFreePtr(lpItemID);
  end;
end;Код: procedure TForm1.Button5Click(Sender: TObject);
var
  chosenDirectory : string;
begin
 if SelectDirectory('Выберите каталог', 'C:\', chosenDirectory)
  then ShowMessage('Выбранный каталог = '+chosenDirectory);
end;Код: function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam: LPARAM; lpData:
  LPARAM): Integer; stdcall;
begin
  if (uMsg = BFFM_INITIALIZED) then
    SendMessage(hwnd, BFFM_SETSELECTION, 1, lpData);
  BrowseCallbackProc := 0;
end;
function GetFolderDialog(Handle: Integer; Caption: string; var strFolder:
  string): Boolean;
const
  BIF_STATUSTEXT = $0004;
  BIF_NEWDIALOGSTYLE = $0040;
  BIF_RETURNONLYFSDIRS = $0080;
  BIF_SHAREABLE = $0100;
  BIF_USENEWUI = BIF_EDITBOX or BIF_NEWDIALOGSTYLE;
var
  BrowseInfo: TBrowseInfo;
  ItemIDList: PItemIDList;
  JtemIDList: PItemIDList;
  Path: PAnsiChar;
begin
  Result := False;
  Path := StrAlloc(MAX_PATH);
  SHGetSpecialFolderLocation(Handle, CSIDL_DESKTOP, JtemIDList);
  with BrowseInfo do
  begin
    hwndOwner := GetActiveWindow;
    pidlRoot := JtemIDList;
    SHGetSpecialFolderLocation(hwndOwner, CSIDL_DESKTOP, JtemIDList);
    { return display name of item selected }
    pszDisplayName := StrAlloc(MAX_PATH);
    { set the title of dialog }
    lpszTitle := PChar(Caption); //'Select the folder';
    { flags that control the return stuff }
    ulFlags := ulFlags or BIF_NEWDIALOGSTYLE or BIF_RETURNONLYFSDIRS;
 //ulFlags := ulFlags or BIF_RETURNONLYFSDIRS;
    lpfn := @BrowseCallbackProc;
    { extra info that's passed back in callbacks }
    lParam := LongInt(PChar(strFolder));
  end;
  ItemIDList := SHBrowseForFolder(BrowseInfo);
  if (ItemIDList <> nil) then
    if SHGetPathFromIDList(ItemIDList, Path) then
    begin
      strFolder := Path;
      Result := True
    end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
  s: string;
begin
  if GetFolderDialog(handle, 'Select folder', s) then showmessage(s);
end;Вызывают диалог типа:  Как вызвать системный диалог сохранения и открытия файлов - понятно... а вот выбор папки - ну никак не соображу как. Кто знает, поделитесь. Мне просто интересно каким образом это делается. |