Функция позволяет разместить окно диалога SelectDirectory в середине TRect.
Чтобы разместить по центру экрана: A:=Screen.WorkAreaRect;
Для размещения центра форме: Form1 сделать R: = Rect (Left, Top, Left+Width, Top+Height);
Если параметр ATools = true - отображается доступ к кнопке "New Folder" и PopupMenu системы.
Зависимомти: ShellAPI, ShlObj.
Код:
function SelDirCallBack(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): integer stdcall;
var
WRect, SRect : TRect;
X, Y : smallInt;
W, H: integer;
begin
if uMsg = BFFM_INITIALIZED then
begin
SRect:= Screen.WorkAreaRect;
X:= LoWord(lpData);
Y:= HiWord(lpData);
GetWindowRect(Wnd, WRect);
W:= WRect.Right - WRect.Left;
H:= WRect.Bottom - WRect.Top;
X:= X - (W div 2);
if X < 0 then X:= 0
else if (X + W) > SRect.Right then X:= SRect.Right - W;
Y:= Y - (H div 2);
if Y < 0 then Y:= 0
else if (Y + H) > SRect.Bottom then Y:= SRect.Bottom - H;
MoveWindow(Wnd, X, Y, W, H, True);
end;
Result := 0;
end;
function SelectDirectoryEx(const Caption: string; var Directory: string; ARect: TRect; ATools: boolean = false): boolean;
var
lpItemID : PItemIDList;
BrowseInfo : TBrowseInfo;
DisplayName : array[0..MAX_PATH] of char;
TempPath : array[0..MAX_PATH] of char;
X, Y: smallInt;
begin
Result:= false;
Directory:= '';
X:= ARect.Left + (ARect.Right - ARect.Left) div 2;
Y:= ARect.Top + (ARect.Bottom - ARect.Top) div 2;
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
with BrowseInfo do
begin
hwndOwner := Application.Handle;
pszDisplayName := @DisplayName;
lpszTitle := PChar(Caption);
if ATools then ulFlags:= BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE
else ulFlags := BIF_RETURNONLYFSDIRS;
lpfn := SelDirCallBack;
lparam:= MakeLong(X, Y);
end;
lpItemID := SHBrowseForFolder(BrowseInfo);
if lpItemId <> nil then
begin
SHGetPathFromIDList(lpItemID, TempPath);
Directory := TempPath;
GlobalFreePtr(lpItemID);
Result:= (Directory <> '');
end;
end;