Форум: "WinAPI";
Текущий архив: 2004.08.22;
Скачать: [xml.tar.bz2];
ВнизОбзор папок 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 вся ветка
Форум: "WinAPI";
Текущий архив: 2004.08.22;
Скачать: [xml.tar.bz2];
Память: 0.44 MB
Время: 0.032 c