// SelectADirectory(Self);
function BrowseCallbackProc(dhwnd:HWND; uMsg:longint;
lParam:longint; lpData:longint) : integer; stdcall;
type _exData=record
Path:PWideChar; Caption:PWideChar;
end;
var sFName: ^_exData; r1, r2 : TRect; Y : Integer; hwndOwner: HWnd;
begin
case uMsg of
BFFM_INITIALIZED:
begin
sFName:=Pointer(lpData);
if Length(sFName.Path)<>0 then
SendMessage(dhwnd, BFFM_SETSELECTION , 1, Integer(sfname.Path));
if Length(sFName.Caption)<>0 then
SendMessage(dhwnd, BFFM_SETSTATUSTEXT , 1, Integer(sfname.Caption));
GetWindowRect(dhwnd, r1); // Center in owning window
hwndOwner := GetWindow(dhwnd, GW_OWNER);
GetWindowRect(hwndOwner, r2);
Y := CenterVertical(r2, r1.Bottom-r1.Top) + 10;
if Y < r2.Top then
Y := r2.Top + 30;
MoveWindow(dhwnd, CenterHorizontal(r2, r1.Right-r1.Left),
Y, r1.Right - r1.Left, r1.Bottom - r1.Top, False);
end;
BFFM_VALIDATEFAILED:
begin
result:=1;
exit;
end;
end;
result:=0;
end;
procedure TMyButtonDirSelector.SelectADirectory(Sender : TObject);
type _exData=record
Path:PWideChar; Caption:PWideChar;
end;
var buffer: WideString;
idList, RootItemIDList: PItemIDList;
info: TBrowseInfoW;
_inData:_exData;
begin
SetLength(buffer, MAX_PATH);
with info do begin
hwndOwner := Handle;
pidlRoot := nil;
pszDisplayName := PWideChar(buffer);
lpszTitle := PWideChar('Select A Folder:');
ulFlags := BIF_RETURNONLYFSDIRS;
_inData.Path:=PWideChar(FDirectory);
_inData.Caption := nil;
lParam:=integer(@_inData);
lpfn:=@BrowseCallbackProc;
iImage := 0;
end;
idList := SHBrowseForFolderW(info);
if idList <> nil then begin
SHGetPathFromIDListW(idList, PWideChar(buffer));
SetLength(buffer, StrLen(PWideChar(buffer)));
FDirectory := buffer;
CoTaskMemFree( idList );
end;
end;