VPF::выбор директории - Форум программистов

sgentstuff

Дата 14.7.2006, 11:37 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

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

Репутация: нет
Всего: 1

Код


//выбор каталогоа
function change_cat:string;
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);
    GlobalFreePtr(lpItemID);
  end;
Result:=TempPath;
end;

этот код позволяет получить выбранный каталог, как изменить его так, чтобы после выбора каталога однажды, при следущем выборе мы находились в директории которую выбирали до этого?

--------------------

Тот, кто ищет миллионы, весьма редко их находит, но тот, кто их не ищет, не находит никогда.

Alexeis

Дата 14.7.2006, 11:49 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Функция SHBrowseForFolder, допускает только изменене корневой папки (откуда "растет" дерево)

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

Romikgy

Дата 14.7.2006, 12:22 (ссылка)

(нет голосов)

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 26
Всего: 146

sgentstuff, качай читай ДРКБ

Код


myDir: string; 

function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam: LPARAM; lpData: 
LPARAM): integer; stdcall; 
begin 
 Result := 0;  
 
 if uMsg = BFFM_INITIALIZED then begin  
 
 SendMessage(hwnd, BFFM_SETSELECTION, 1, LongInt(PChar(myDir)))  
 
 end;  
 
  
end; 

function SelectDirectory(const Caption: string; const Root: WideString; 
var Directory: string): Boolean; 
var 
 WindowList: Pointer;  
 
 BrowseInf!  
 
 o: TBrowseInfo;  
 
 Buffer: PChar;  
 
 RootItemIDList, ItemIDList: PItemIDList;  
 
 ShellMalloc: IMalloc;  
 
 IDesktopFolder: IShellFolder;  
 
 Eaten, Flags: LongWord;  
 
  
begin 
 myDir := Directory;  
 
 Result := False;  
 
 FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);  
 
 if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then  
 
 begin  
 
 Buffer := ShellMalloc.Alloc(MAX_PATH);  
 
 try  
 
 RootItemIDList := nil;  
 
 if Root <> '' then  
 
 begin  
 
  
 SHGetDesktopFolder(IDesktopFolder);  
 
 IDesktopFolder.ParseDisplayName(Application.Handle, nil,  
 
 POleStr(Root), Eaten, RootItemIDList, Flags);  
 
  
 end;  
 
 with BrowseInfo do  
 
 begin  
 
  
 hwndOwner := Application.Handle;  
 
 pidlRoot := RootItemIDList;  
 
 pszDisplayName := Buffer;  
 
 lpfn := @BrowseCallbackProc;  
 
 lParam := Integer(PChar(Directory));  
 
 lpszTitle := PChar(Caption);  
 
 ulFlags := BIF_RETURNONLYFSDIRS or $0040 or BIF_EDITBOX or  
 
 BIF_STATUSTEXT;  
 
  
 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);  
 
 Directory := Buffer;  
 
  
 end;  
 
 finally  
 
  
 ShellMalloc.Free(Buffer);  
 
  
 end;  
 
 end;  
 
  
end;

--------------------

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

Yanis

Дата 14.7.2006, 12:38 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

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

Репутация: 72
Всего: 111

Тот же пример, но в удобоваримой форме + пример использования:

Код

threadvar
  myDir: string;

implementation

{$R *.dfm}

function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam: LPARAM; lpData:
  LPARAM): integer; stdcall;
begin
  Result := 0;
  if uMsg = BFFM_INITIALIZED then
    begin
      SendMessage(hwnd, BFFM_SETSELECTION, 1, LongInt(PChar(myDir)))
    end;
end;

function SelectDirectory(const Caption: string; const Root: WideString;
  var Directory: string): Boolean;
var
  WindowList: Pointer;
  BrowseInfo: TBrowseInfo;
  Buffer: PChar;
  RootItemIDList, ItemIDList: PItemIDList;
  ShellMalloc: IMalloc;
  IDesktopFolder: IShellFolder;
  Eaten, Flags: LongWord;
begin
  myDir := Directory;
  Result := False;
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
    begin
      Buffer := ShellMalloc.Alloc(MAX_PATH);
      try
        RootItemIDList := nil;
        if Root <> '' then
          begin
            SHGetDesktopFolder(IDesktopFolder);
            IDesktopFolder.ParseDisplayName(Application.Handle, nil,
              POleStr(Root), Eaten, RootItemIDList, Flags);
          end;

        with BrowseInfo do
          begin
            hwndOwner := Application.Handle;
            pidlRoot := RootItemIDList;
            pszDisplayName := Buffer;
            lpfn := @BrowseCallbackProc;
            lParam := Integer(PChar(Directory));
            lpszTitle := PChar(Caption);
            ulFlags := BIF_RETURNONLYFSDIRS or $0040 or BIF_EDITBOX or
              BIF_STATUSTEXT;
          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);
            Directory := Buffer;
          end;
      finally
        ShellMalloc.Free(Buffer);
      end;
    end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  s: string;
  w: WideString;
begin
  s := 'C:\Windows\';
  SelectDirectory('Hi!', w, s);
  ShowMessage(s);
end;

--------------------

*щёлк*

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »