Uses Windows, Messages,
ActiveX, ShlObj;
Type TFolderRec =
Record
Title, Caption, Folder: PWideChar;
End;
PFolderRec = ^TFolderRec;
Function FolderCallback(Dlg: HWND; Msg: LongWord; LParam: Pointer; Data: PFolderRec): LongWord;
StdCall;
Var Temp:
Array[0..MAX_PATH-1]
of WideChar;
Begin
Case Msg
of
BFFM_INITIALIZED:
Begin
If Data^.Title <>
nil Then
SendMessageW(Dlg, WM_SETTEXT, 0, Integer(Data^.Title));
If Data^.Folder <>
nil Then
SendMessage(Dlg, BFFM_SETSELECTION, LongInt(True), Integer(Data^.Folder));
End;
BFFM_SELCHANGED:
Begin
SHGetPathFromIDListW(PItemIDList(LParam), @Temp);
If SendMessageW(Dlg, BFFM_SETSTATUSTEXT, 0, LongWord(@Temp)) = 0
Then
SetWindowTextW(GetDlgItem(Dlg, 14146), PWideChar(WideString(Data^.Caption)
+ sLineBreak + sLineBreak + Temp));
End;
BFFM_VALIDATEFAILED:
Begin
Result := 1;
Exit;
End;
End;
Result := 0;
End;
Function BrowseForFolder(Wnd: HWND;
Const Title, Caption, PreSelectedFolder: WideString; AllowNewFolder: Boolean;
Var SelectedDir: WideString): Boolean;
Var BI: TBrowseInfo;
FolderRec: TFolderRec;
pidlResult: PItemIDList;
Temp:
Array[0..MAX_PATH-1]
of WideChar;
Malloc: IMalloc;
Begin
Result := False;
ZeroMemory(@BI, SizeOf(TBrowseInfo));
BI.hwndOwner := Wnd;
BI.lpszTitle := PWideChar(Caption);
BI.ulFlags := BIF_STATUSTEXT
{or BIF_NEWDIALOGSTYLE} or BIF_SHAREABLE
or BIF_RETURNONLYFSDIRS;
BI.lpfn := @FolderCallBack;
BI.lParam := Integer(@FolderRec);
If not AllowNewFolder
Then BI.ulFlags := BI.ulFlags
or BIF_NONEWFOLDERBUTTON;
FolderRec.Title := PWideChar(Title);
FolderRec.Caption := PWideChar(Caption);
FolderRec.Folder := PWideChar(PreSelectedFolder);
pidlResult := SHBrowseForFolderW(BI);
If pidlResult =
nil Then Exit;
If SHGetPathFromIdListW(pidlResult, @Temp[0])
Then Begin
Result := True;
SelectedDir := Temp;
End;
If SHGetMalloc(Malloc) = S_OK
Then
Try
Malloc.Free(pidlResult);
Finally
Malloc :=
nil;
End;
End;