uses shlObj;
function BrowseCallbackProc(hwnd: HWND; MessageID: UINT; lParam: LPARAM; lpData: LPARAM): Integer;
stdcall;
var
DirName:
array[0..MAX_PATH]
of Char;
pIDL : pItemIDList;
p:tagWINDOWPOS;
begin
case MessageID
of
BFFM_INITIALIZED:
begin
SendMessage(hwnd, BFFM_SETSELECTION, 1, lpData);
SetWindowPos(hwnd,hwnd,10,10,800,400,sw_show);
end;
BFFM_SELCHANGED :
begin
pIDL := Pointer(lParam);
if Assigned(PIDL)
then
begin
SHGetPathFromIDList(pIDL, DirName);
if DirectoryExists(DirName)
then
if 1=1
then //(ExtractFileName(DirName)='Windows') then
SendMessage(hwnd, BFFM_ENABLEOK, 0, 1)
else
SendMessage(hwnd, BFFM_ENABLEOK, 0, 0)
else
SendMessage(hwnd, BFFM_ENABLEOK, 0, 0);
end
else
SendMessage(hwnd, BFFM_ENABLEOK, 0, 0);
end;
end;
Result := 0;
end;
function SelectFolderDialogExt(
Handle: Integer;
var SelectedFolder:
string): Boolean;
var
ItemIDList: PItemIDList;
JtemIDList: PItemIDList;
DialogInfo: TBrowseInfo;
Path: PChar;
begin
Result := False;
Path := StrAlloc(MAX_PATH);
SHGetSpecialFolderLocation(
Handle, CSIDL_DRIVES, JtemIDList);
with DialogInfo
do
begin
pidlRoot := JtemIDList;
//ulFlags := BIF_RETURNONLYFSDIRS; //only select directories
hwndOwner := GetActiveWindow;
SHGetSpecialFolderLocation(hwndOwner, CSIDL_DRIVES, JtemIDList);
pszDisplayName := StrAlloc(MAX_PATH);
lpszTitle := PChar('
Select a folder');
lpfn := @BrowseCallbackProc;
lParam := LongInt(PChar(SelectedFolder));
end;
ItemIDList := SHBrowseForFolder(DialogInfo);
if (ItemIDList <>
nil)
then
if SHGetPathFromIDList(ItemIDList, Path)
then
begin
SelectedFolder := Path;
Result := True;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
dir:
String;
f:Tform;
begin
SelectFolderDialogExt(Panel1.Handle,dir);
Caption := Dir;
end;