|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
||||
|
||||
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; Последний раз редактировалось Admin, 09.04.2010 в 14:09. |