16.07.2007, 11:25
|
|
Местный
|
|
Регистрация: 06.09.2006
Адрес: Россия, Санкт-Петербург
Сообщения: 444
Репутация: 550
|
|
В uses добавь ActiveX и ShlObj, ComObj (или один из этих модулей, я просто не помню точно...)
Код:
// функция показа диалога для выбора папки
function AdvBrowseDirectory(sCaption: String; wsRoot: WideString; var sDirectory: String; bEditBox: Boolean = False; bShowFiles: Boolean = False; bAllowCreateDirs: Boolean = True; bRootIsMyComp: Boolean = False): Boolean;
// callback функция, которая вызывается при инициализации диалога
// или когда создается новая папка
function SelectDirCB(Wnd: HWND; uMsg: UINT; lParam, lpData: lParam): Integer; stdcall;
//var
//PathName: array[0..MAX_PATH] of Char;
begin
case uMsg of
BFFM_INITIALIZED: SendMessage(Wnd, BFFM_SETSELECTION, Ord(True), Integer(lpData));
// включите этот код, если хотите реагировать на выбор новой папки
{BFFM_SELCHANGED:
begin
SHGetPathFromIDList(PItemIDList(lParam), @PathName);
// папка "PathName" была выбрана
end;}
end;
Result := 0;
end;
var
WindowList: Pointer;
BrowseInfo: TBrowseInfo;
Buffer: PChar;
RootItemIDList, ItemIDList: PItemIDList;
ShellMalloc: IMalloc;
IDesktopFolder: IShellFolder;
Eaten, Flags: LongWord;
const
BIF_USENEWUI = $0040;
BIF_NOCREATEDIRS = $0200;
begin
Result := False;
if not DirectoryExists(sDirectory) then sDirectory := '';
FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
begin
Buffer := ShellMalloc.Alloc(MAX_PATH);
try
RootItemIDList := nil;
if wsRoot <> '' then
begin
SHGetDesktopFolder(IDesktopFolder);
IDesktopFolder.ParseDisplayName(Application.Handle, nil,
POleStr(wsRoot), Eaten, RootItemIDList, Flags);
end
else
begin
if bRootIsMyComp then
SHGetSpecialFolderLocation(0, CSIDL_DRIVES, RootItemIDList);
end;
OleInitialize(nil);
with BrowseInfo do
begin
hwndOwner := Application.Handle;
pidlRoot := RootItemIDList;
pszDisplayName := Buffer;
lpszTitle := PChar(sCaption);
// определяет то, как диалог будет появляться:
ulFlags :=
BIF_RETURNONLYFSDIRS or
BIF_USENEWUI or
BIF_EDITBOX * Ord(bEditBox) or
BIF_BROWSEINCLUDEFILES * Ord(bShowFiles) or
BIF_NOCREATEDIRS * Ord(not bAllowCreateDirs);
lpfn := @SelectDirCB;
if sDirectory <> '' then lParam := Integer(PChar(sDirectory));
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);
sDirectory := Buffer;
end;
finally
ShellMalloc.Free(Buffer);
end;
end;
end;
Пример использования:
Код:
//...
var
sSelectedDir: String;
//...
begin
//...
AdvBrowseDirectory('Выбор папки с файлами','',sSelectedDir);
// теперь в sSelectedDir у нас выбранная папка
//...
end;
__________________
THE CRACKER IS OUT THERE
|