Показать сообщение отдельно
  #1  
Старый 09.04.2010, 14:00
Аватар для Admin
Admin Admin вне форума
Администратор
 
Регистрация: 03.10.2005
Адрес: Россия, Москва
Сообщения: 1,560
Версия Delphi: Delphi 7
Репутация: выкл
По умолчанию SelectDirectory по центру TRect

Функция позволяет разместить окно диалога 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;
Ответить с цитированием