Текущий архив: 2004.08.22;
Скачать: CL | DM;

Вниз

Обзор папок SGHBrowseFolder   Найти похожие ветки 

← →
DDDeN   (2004-07-13 16:05) [0]

Подскажите плз как получить путь при помощи окна "Обзор папок"!!! Без всяких компонент.

---

← →
AD_infiniTUM   (2004-07-13 16:11) [1]

unit DirDlg;

interface

uses
 Windows, Messages;

function GetDirectory(Wnd: HWnd; var Dir: string; const DialogText: string): Boolean;

implementation

uses
 ShlObj;

const
 BIF_RETURNONLYFSDIRS = $0001;
 BIF_RETURNFSANCESTORS = $0008;
 BFFM_INITIALIZED = 1;
 BFFM_SETSELECTION = WM_USER + 102;

var
 ADir: string;

procedure CoTaskMemFree(pv: Pointer); stdcall; external "ole32.dll" name "CoTaskMemFree";

function ExplorerHook(Wnd: HWnd; Msg: UINT; LParam: LPARAM; Data: LPARAM): Integer; stdcall;
begin
 Result := 0;
 if Msg = BFFM_INITIALIZED then
   SendMessage(wnd, BFFM_SETSELECTION, 1, Longint(PChar(ADir)));
end;

function GetDirectory(Wnd: HWnd; var Dir: string; const DialogText: string): Boolean;
var
 BrowseInfo: TBrowseInfo;
 ItemIDList: PItemIDList;
 Temp: array[0..MAX_PATH] of Char;
begin
 ADir := Dir;
 FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
 with BrowseInfo do
 begin
   pidlRoot := nil;
   lpszTitle := PChar(DialogText);
   ulFlags := BIF_RETURNONLYFSDIRS or BIF_RETURNFSANCESTORS;
   lpfn := ExplorerHook;
   hWndOwner := Wnd;
   iImage := 0;
 end;
 ItemIDList := SHBrowseForFolder(BrowseInfo);
 Result := ItemIDList <> nil;
 if Result then
 begin
   SHGetPathFromIDList(ItemIDList, Temp);
   Dir := Temp;
   CoTaskMemFree(ItemIDList);
 end;
end;

end.

---

Страницы: 1 вся ветка

Текущий архив: 2004.08.22;
Скачать: CL | DM;

Наверх

Память: 0.47 MB
Время: 0.04 c