Windows 7 x64, Delphi и диалог выбора папки
Известная проблема Windows 7 x64: пара ShBrowseForFolder + BFFM_SETSELECTION не прокручивает список. Курсор переходит куда надо, но остаётся «за кадром». Решений много, и, кажется, я сумел найти стопроцентно работающее и без жонглирования недокументированными константами. Сдираем прямо из модуля Vcl.FileCtrl (Delphi XE2). К объекту TSelectDirCallback добавляем поле fTryOtherTime : boolean. Ну и плюс одна функция (внимание, корректив для CLR-режима не вносил).
function TSelectDirCallback.SelectDirCB( Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer; var Rect: TRect; Monitor: TMonitor; begin Result := 0; case uMsg of BFFM_SELCHANGED: if fTryOtherTime then begin fTryOtherTime := false; PostMessage(Wnd, BFFM_SETSELECTION, Winapi.Windows.WPARAM(True), Winapi.Windows.LPARAM(PChar(FDirectory))); end; BFFM_INITIALIZED: begin if Assigned(Application.MainForm) then Monitor := Screen.MonitorFromWindow(Application.MainForm.Handle) else Monitor := Screen.MonitorFromWindow(0); GetWindowRect(Wnd, Rect); SetWindowPos(Wnd, 0, Monitor.Left + (Monitor.Width - (Rect.Right - Rect.Left)) div 2, Monitor.Top + (Monitor.Height - (Rect.Bottom - Rect.Top)) div 2, 0, 0, SWP_NOSIZE or SWP_NOZORDER); if FDirectory <> '' then {$IF DEFINED(CLR)} begin if Marshal.SystemDefaultCharSize = 2 then SendTextMessage(Wnd, BFFM_SETSELECTIONW, Winapi.Windows.WPARAM(Ord(True)), FDirectory) else SendTextMessage(Wnd, BFFM_SETSELECTIONA, Winapi.Windows.WPARAM(Ord(True)), FDirectory) end {$ELSE} fTryOtherTime := true; SendMessage(Wnd, BFFM_SETSELECTION, Winapi.Windows.WPARAM(True), Winapi.Windows.LPARAM(PChar(FDirectory))); {$IFEND} end else if (uMsg = BFFM_VALIDATEFAILEDW) or (uMsg = BFFM_VALIDATEFAILEDA) then begin {$IF DEFINED(CLR)} MessageDlg(Format(SInvalidPath, [Marshal.PtrToStringAuto(IntPtr(lParam))]), mtError, [mbOK], 0); {$ELSE} MessageDlg(Format(SInvalidPath, [PChar(lParam)]), mtError, [mbOK], 0); {$IFEND} Result := 1; end; end; // case end;