unit SelDirU;
interface
uses Windows, ActiveX, ShlObj;
var
SelectDir :string;
BrowseInfo :TBrowseInfo;
function SelDir(const Caption: string; const Root: WideString; const Select: string;const CreateNewDir: Boolean; const BrowseFiles: Boolean; out Directory: string): Boolean;
function BrowseCallbackProc(Wnd: HWND; uMsg: UINT;lPar, lpData: LPARAM): Integer stdcall;
implementation
uses
Forms, SysUtils;
function SelDir(const Caption: string; const Root: WideString; const Select: string;
const CreateNewDir: Boolean; const BrowseFiles: Boolean; out Directory: string): Boolean;
var
Buffer: PChar;
ItemIDList: PItemIDList;
ShellMalloc: IMalloc;
IDesktopFolder: IShellFolder;
Eaten, Flags: LongWord;
RootItemIDList: PItemIDList;
Titulek,Adrs: string;
begin
Result := False;
Directory := '';
SelectDir := Select;
if Caption='' then Titulek := 'Vyberte adresár:' // nadpis
else Titulek := Caption;
FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then begin
Buffer := ShellMalloc.Alloc(MAX_PATH);
try
if (Length(Root)>0) then begin
SHGetDesktopFolder(IDesktopFolder);
IDesktopFolder.ParseDisplayName(Application.Handle, nil, POleStr(Root), Eaten, RootItemIDList, Flags);
end
else
RootItemIDList := nil;
with BrowseInfo do begin
hwndOwner := Application.Handle;
pidlRoot := RootItemIDList;
pszDisplayName := Buffer;
lpszTitle := PChar(Titulek);
ulFlags := BIF_STATUSTEXT;
if BrowseFiles then ulFlags := ulFlags or BIF_BROWSEINCLUDEFILES
else ulFlags := ulFlags or BIF_RETURNONLYFSDIRS;
if CreateNewDir then ulFlags := ulFlags or BIF_NEWDIALOGSTYLE;
lpfn := BrowseCallbackProc;
end;
ItemIDList := ShBrowseForFolder(BrowseInfo);
Result := ItemIDList <> nil;
if Result then begin
ShGetPathFromIDList(ItemIDList, Buffer);
ShellMalloc.Free(ItemIDList);
Adrs := Buffer;
if BrowseFiles then
Directory := Adrs
else
Directory := IncludeTrailingPathDelimiter(Adrs);
end;
finally
ShellMalloc.Free(Buffer);
end;
end;
end;
function BrowseCallbackProc(Wnd: HWND; uMsg: UINT;lPar, lpData: LPARAM): Integer stdcall;
var
Buffer : array[0..MAX_PATH - 1] of char;
Buffer1 : array[0..MAX_PATH - 1] of char;
hStatus : HWND;
buff : AnsiString;
const
WM_SETTEXT = $000C;
begin
case uMsg of
BFFM_INITIALIZED:
begin
// CenterWindow(Wnd);
if DirectoryExists(SelectDir) then
SendMessage(Wnd, BFFM_SETSELECTION, 1, LPARAM(SelectDir));
end;
BFFM_SELCHANGED:
begin
SHGetPathFromIDList(PItemIDList(lPar), Buffer);
if (BrowseInfo.ulFlags and BIF_NEWDIALOGSTYLE) = 0 then begin
SendMessage(Wnd, BFFM_SETSTATUSTEXT, 0, Integer(@Buffer));
end
else begin
hStatus := FindWindowEx(Wnd, 0, 'Static', nil);
if hStatus <> 0 then begin
buff := BrowseInfo.lpszTitle + #13#13 + Buffer + #0;
Move(buff[1], Buffer1, Length(buff));
SendMessage(hStatus, WM_SETTEXT, 0, Integer(@Buffer1));
end;
end;
end;
end;
Result := 0;
end;
end.
