Прокрутка происхождения
Действие с колесом мыши приводит к отправке WM_MOUSEWHEEL сообщения :
Отправляется в окно фокусировки при вращении колесика мыши. Функция DefWindowProc передает сообщение родителю окна. Не должно быть внутренней пересылки сообщения, поскольку DefWindowProc распространяет его по родительской цепочке, пока не найдет окно, которое его обрабатывает.
Одиссея колесика мыши 1)
- Пользователь прокручивает колесо мыши.
- Система помещает сообщение
WM_MOUSEWHEEL в очередь сообщений потока переднего окна.
- Цикл сообщений потока извлекает сообщение из очереди (
Application.ProcessMessage). Это сообщение типа TMsg, в котором есть hwnd элемент, обозначающий дескриптор окна, для которого предназначено сообщение.
- Событие
Application.OnMessage происходит.
- Установка параметра
Handled True останавливает дальнейшую обработку сообщения (кроме следующих шагов).
- Вызывается метод
Application.IsPreProcessMessage.
- Если элемент управления не захватил мышь, вызывается метод
PreProcessMessage для сфокусированного элемента управления, который по умолчанию ничего не делает. Ни один элемент управления в VCL не переопределил этот метод.
- Вызывается метод
Application.IsHintMsg.
- Активное окно подсказки обрабатывает сообщение переопределенным методом
IsHintMsg. Запретить дальнейшую обработку сообщения невозможно.
DispatchMessage называется. - Метод сфокусированного окна
TWinControl.WndProc получает сообщение. Это сообщение типа TMessage, в котором отсутствует окно (потому что это тот экземпляр, к которому вызывается этот метод).
- Метод
TWinControl.IsControlMouseMsg вызывается для проверки того, должно ли сообщение мыши быть направлено на один из его неоконных дочерних элементов управления.
- Если есть дочерний элемент управления, который захватил мышь или находится в текущей позиции мыши 2) , то сообщение отправляется методу
WndProc дочернего элемента управления, см. Шаг 10. ( 2) Это никогда не произойдет, поскольку WM_MOUSEWHEEL содержит свою позицию мыши в экранных координатах, а IsControlMouseMsg предполагает положение мыши в клиентских координатах (XE2).)
- Унаследованный метод
TControl.WndProc получает сообщение.
- Если система изначально не поддерживает колесико мыши (CM_MOUSEWHEEL и отправляется на
TControl.MouseWheelHandler, см. Шаг 13.
- В противном случае сообщение отправляется соответствующему обработчику сообщений.
- Метод
TControl.WMMouseWheel получает сообщение.
-
WM_MOUSEWHEEL w indow m essage (имеет значение для системы и часто для VCL) преобразуется в CM_MOUSEWHEEL c контроль m essage (имеет смысл только для VCL), который предоставляет удобную информацию VCL ShiftState вместо данных ключей системы.
- Вызывается метод
MouseWheelHandler элемента управления.
- Если элемент управления
TCustomForm, то вызывается метод TCustomForm.MouseWheelHandler.
- Если на нем есть сфокусированный элемент управления, то
CM_MOUSEWHEEL отправляется на фокусированный элемент управления, см. Шаг 14.
- В противном случае вызывается унаследованный метод, см. Шаг 13.2.
- В противном случае вызывается метод
TControl.MouseWheelHandler.
- Если существует элемент управления, который захватил мышь и не имеет родителя 3) , то сообщение отправляется этому элементу управления, см. Шаг 8 или 10, в зависимости от типа элемента управления. ( 3) Это никогда не произойдет, потому что
Capture получается с GetCaptureControl, который проверяет Parent <> nil (XE2).)
- Если элемент управления находится в форме, то вызывается форма элемента управления
MouseWheelHandler, см. Шаг 13.1.
- В противном случае, или если элемент управления является формой, тогда элемент управления
CM_MOUSEWHEEL отправляется в элемент управления, см. Шаг 14.
- Метод
TControl.CMMouseWheel получает сообщение.
- Вызывается метод
TControl.DoMouseWheel.
- Событие
OnMouseWheel сработало.
- IЕсли f не обрабатывается, то вызывается
TControl.DoMouseWheelDown или TControl.DoMouseWheelUp, в зависимости от направления прокрутки.
- Событие
OnMouseWheelDown или OnMouseWheelUp происходит.
- Если не обработано, то
CM_MOUSEWHEEL отправляется родительскому элементу управления, см. Шаг 14. (Я считаю, что это противоречит совету, данному MSDN в приведенной выше цитате, но это, несомненно, продуманное решение, принятое разработчиками. Возможно, потому что это положило бы начало всей этой цепочке.)
Замечания, замечания и соображения
Почти на каждом этапе в этой цепочке обработки сообщение можно игнорировать, ничего не делая, изменяя его, изменяя параметры сообщения, обрабатывая его и отменяя настройкой Handled := True или установкой Message.Result в ненулевое значение .
Только когда какой-то элемент управления имеет фокус, это сообщение принимается приложением. Но даже когда Screen.ActiveCustomForm.ActiveControl принудительно установлен на nil, VCL обеспечивает сфокусированное управление с TCustomForm.SetWindowFocus, которое по умолчанию имеет ранее активную форму. (С Windows.SetFocus(0), действительно, сообщение никогда не отправляется.)
Из-за ошибки в IsControlMouseMsg 2) , TControl может получить сообщение WM_MOUSEWHEEL, только если оно захватило мышь. Это можно сделать вручную , установив Control.MouseCapture := True, но вы должны позаботиться о скорейшем освобождении этого захвата, иначе у него будут нежелательные побочные эффекты, такие как необходимость лишнего дополнительного щелчка, чтобы что-то сделать. Кроме того, захват мыши , как правило, происходит только между событием «нажатие мыши» и «вверх», но это ограничение не обязательно должно применяться. Но даже когда сообщение достигает элемента управления, оно отправляется методу MouseWheelHandler, который просто отправляет его обратно либо в форму, либо в активный элемент управления. Таким образом, неоконные элементы управления VCL никогда не могут воздействовать на сообщение по умолчанию. Я полагаю, что это еще одна ошибка, иначе почему бы все управление колесами было реализовано в TControl? Авторы компонентов, возможно, реализовали свой собственный метод MouseWheelHandler для этой цели, и какое бы решение ни пришло к этому вопросу, нужно позаботиться о том, чтобы не сломать этот вид существующей настройки.
Собственные элементы управления , которые могут прокручиваться с помощью колеса, такие как TMemo, TListBox, TDateTimePicker, TComboBox, TTreeView, TListView и т. Д., Прокручиваются сама система. Отправка CM_MOUSEWHEEL на такой элемент управления по умолчанию не действует. Эти подклассы управляют прокруткой в результате сообщения WM_MOUSEWHEEL, отправленного в оконную процедуру API, связанную с подклассом, с CallWindowProc, о которой VCL заботится в TWinControl.DefaultHandler. Как ни странно, эта процедура не проверяет Message.Result перед вызовом CallWindowProc, и после отправки сообщения прокрутка не может быть предотвращена. Сообщение возвращается с его установленным Result в зависимости от того, способен ли элемент управления обычно прокручиваться или от типа элемента управления. (Например, a TMemo возвращает <> 0, а TEdit возвращает 0.) То, будет ли эта прокрутка фактически не влиять на результат сообщения.
Элементы управления VCL полагаются на обработку по умолчанию, реализованную в TControl и TWinControl, как изложено выше. Они действуют на событиях колеса в DoMouseWheel, DoMouseWheelDown или DoMouseWheelUp. Насколько я знаю, ни один элемент управления в VCL не переопределил MouseWheelHandler для обработки событий колеса.
Глядя на различные приложения, кажется, что нет соответствия стандартному поведению колесной прокрутки. Например: MS Word прокручивает отображаемую страницу, MS Excel прокручивает рабочую книгу, которая сфокусирована, Windows Eplorer прокручивает сфокусированную панель, веб-сайты реализуют поведение прокрутки по-разному, Evernote прокручивает окно, которое отображается, и т. Д ... И Delphi's Собственная IDE превосходит все, прокручивая сфокусированное окно , а также наведенное окно, кроме случаев, когда вы наводите курсор мыши на редактор кода, тогда редактор кода во время прокрутки (XE2) крадет фокус .
К счастью, Microsoft предлагает как минимум руководств по работе с пользователями для настольных приложений на базе Windows :
- Заставьте колесо мыши влиять на элемент управления, панель или окно, над которым в данный момент находится указатель. Это позволяет избежать непредвиденных результатов.
- Включите колесико мыши, не щелкая мышью и не имея фокуса ввода. Наведение достаточно.
- Сделайте так, чтобы колесо мыши воздействовало на объект с наиболее определенной областью действия. Например, если указатель находится над элементом управления прокручиваемого списка в прокручиваемой панели внутри прокручиваемого окна, колесо мыши влияет на список. коробка управления.
- Не меняйте фокус ввода при использовании колесика мыши.
Таким образом, требование вопроса только прокрутить находящийся элемент управления имеет достаточные основания, но разработчики Delphi не упростили его реализацию.
Вывод и решение
Предпочтительным решением является решение без окон подклассов или нескольких реализаций для различных форм или элементов управления.
Чтобы предотвратить прокрутку сфокусированного элемента управления, элемент управления может не получить сообщение CM_MOUSEWHEEL. Следовательно, MouseWheelHandler любого контроля не может быть вызван. Следовательно, WM_MOUSEWHEEL не может быть отправлено никакому элементу управления. Таким образом, единственное место, оставленное для вмешательства, - TApplication.OnMessage. Кроме того, сообщение может не выходить из него, поэтому обработка all должна происходить в этом обработчике событий, и когда вся обработка колеса VCL по умолчанию обойдена, необходимо учитывать все возможные условия.
Давайте начнем с простого. Активированное окно, которое в данный момент находится в окне, вызывается с WindowFromPoint.
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
var
Window: HWND;
begin
if Msg.message = WM_MOUSEWHEEL then
begin
Window := WindowFromPoint(Msg.pt);
if Window <> 0 then
begin
Handled := True;
end;
end;
end;
С помощью FindControl мы получаем ссылку на элемент управления VCL. Если результат равен nil, то окно наведения не относится к процессу приложения или это окно, неизвестное VCL (например, выпадающее меню TDateTimePicker). В этом случае сообщение необходимо переслать обратно в API, и его результат нас не интересует.
WinControl: TWinControl;
WndProc: NativeInt;
WinControl := FindControl(Window);
if WinControl = nil then
begin
WndProc := GetWindowLongPtr(Window, GWL_WNDPROC);
CallWindowProc(Pointer(WndProc), Window, Msg.message, Msg.wParam,
Msg.lParam);
end
else
begin
end;
Когда окно является элементом управления VCL, несколько обработчиков сообщений должны рассматриваться как вызывающие в определенном порядке. Когда в позиции мыши есть включенный неоконный элемент управления (типа TControl или потомок), он сначала должен получить сообщение CM_MOUSEWHEEL, поскольку этот элемент управления, безусловно, является передним элементом управления. Сообщение должно быть составлено из сообщения WM_MOUSEWHEEL и переведено в его эквивалент VCL. Во-вторых, сообщение WM_MOUSEWHEEL должно быть отправлено методу DefaultHandler элемента управления, чтобы разрешить обработку для собственных элементов управления. И наконец, снова сообщение CM_MOUSEWHEEL должно быть отправлено элементу управления, когда ни один предыдущий обработчик не позаботился о сообщении. Эти два последних шага не могут быть выполнены в обратном порядке, например, потому что заметка на поле прокрутки должна быть в состоянии прокручивать тоже.
Point: TPoint;
Message: TMessage;
Point := WinControl.ScreenToClient(Msg.pt);
Message.WParam := Msg.wParam;
Message.LParam := Msg.lParam;
TCMMouseWheel(Message).ShiftState :=
KeysToShiftState(TWMMouseWheel(Message).Keys);
Message.Result := WinControl.ControlAtPos(Point, False).Perform(
CM_MOUSEWHEEL, Message.WParam, Message.LParam);
if Message.Result = 0 then
begin
Message.Msg := Msg.message;
Message.WParam := Msg.wParam;
Message.LParam := Msg.lParam;
WinControl.DefaultHandler(Message);
end;
if Message.Result = 0 then
begin
Message.WParam := Msg.wParam;
Message.LParam := Msg.lParam;
TCMMouseWheel(Message).ShiftState :=
KeysToShiftState(TWMMouseWheel(Message).Keys);
Message.Result := WinControl.Perform(CM_MOUSEWHEEL, Message.WParam,
Message.LParam);
end;
Когда окно захватывает мышь, все сообщения колеса должны быть отправлены на него. Окно, полученное с помощью GetCapture, обязательно будет окном текущего процесса, но оно не обязательно должно быть элементом управления VCL. Например. во время операции перетаскивания создается временное окно (см. TDragObject.DragHandle), которое принимает сообщения мыши. Все сообщения? Нееет, WM_MOUSEWHEEL не отправляется в окно захвата, поэтому мы должны перенаправить его. Кроме того, когда окно захвата не обрабатывает сообщение, должна выполняться вся другая ранее описанная обработка. Эта особенность отсутствует в VCL: при работе во время операции перетаскивания действительно вызывается Form.OnMouseWheel, но элемент управления с фокусировкой или зависанием не получает сообщение. Это означает, например, что текст нельзя перетащить в содержимое заметки в месте, которое находится за пределами видимой части заметки.
Window := GetCapture;
if Window <> 0 then
begin
Message.Result := GetCaptureControl.Perform(CM_MOUSEWHEEL, Message.WParam,
Message.LParam);
if Message.Result = 0 then
Message.Result := SendMessage(Window, Msg.message, Msg.wParam,
Msg.lParam);
end;
Это, по сути, делает работу, и это было основой для единицы, представленной ниже. Чтобы заставить его работать, просто добавьте имя модуля в одно из предложений использования в вашем проекте. Он имеет следующие дополнительные функции:
- Возможность предварительного просмотра действия колеса в главной форме, активной форме или активном элементе управления.
- Регистрация классов управления, для которых должен быть вызван их метод
MouseWheelHandler.
- Возможность поставить этот
TApplicationEvents объект перед всеми остальными.
- Возможность отменить отправку события
OnMessage всем другим TApplicationEvents объектам.
- Возможность по-прежнему разрешать обработку VCL по умолчанию впоследствии для аналитических или тестовых целей.
ScrollAnywhere.pas
unit ScrollAnywhere;
interface
uses
System.Classes, System.Types, System.Contnrs, Winapi.Windows, Winapi.Messages,
Vcl.Controls, Vcl.Forms, Vcl.AppEvnts;
type
TWheelMsgSettings = record
MainFormPreview: Boolean;
ActiveFormPreview: Boolean;
ActiveControlPreview: Boolean;
VclHandlingAfterHandled: Boolean;
VclHandlingAfterUnhandled: Boolean;
CancelApplicationEvents: Boolean;
procedure RegisterMouseWheelHandler(ControlClass: TControlClass);
end;
TMouseHelper = class helper for TMouse
public
class var WheelMsgSettings: TWheelMsgSettings;
end;
procedure Activate;
implementation
type
TWheelInterceptor = class(TCustomApplicationEvents)
private
procedure ApplicationMessage(var Msg: tagMSG; var Handled: Boolean);
public
constructor Create(AOwner: TComponent); override;
end;
var
WheelInterceptor: TWheelInterceptor;
ControlClassList: TClassList;
procedure TWheelInterceptor.ApplicationMessage(var Msg: tagMSG;
var Handled: Boolean);
var
Window: HWND;
WinControl: TWinControl;
WndProc: NativeInt;
Message: TMessage;
OwningProcess: DWORD;
procedure WinWParamNeeded;
begin
Message.WParam := Msg.wParam;
end;
procedure VclWParamNeeded;
begin
TCMMouseWheel(Message).ShiftState :=
KeysToShiftState(TWMMouseWheel(Message).Keys);
end;
procedure ProcessControl(AControl: TControl;
CallRegisteredMouseWheelHandler: Boolean);
begin
if (Message.Result = 0) and CallRegisteredMouseWheelHandler and
(AControl <> nil) and
(ControlClassList.IndexOf(AControl.ClassType) <> -1) then
begin
AControl.MouseWheelHandler(Message);
end;
if Message.Result = 0 then
Message.Result := AControl.Perform(CM_MOUSEWHEEL, Message.WParam,
Message.LParam);
end;
begin
if Msg.message <> WM_MOUSEWHEEL then
Exit;
with Mouse.WheelMsgSettings do
begin
Message.Msg := Msg.message;
Message.WParam := Msg.wParam;
Message.LParam := Msg.lParam;
Message.Result := LRESULT(Handled);
// Allow controls for which preview is set to handle the message
VclWParamNeeded;
if MainFormPreview then
ProcessControl(Application.MainForm, False);
if ActiveFormPreview then
ProcessControl(Screen.ActiveCustomForm, False);
if ActiveControlPreview then
ProcessControl(Screen.ActiveControl, False);
// Allow capturing control to handle the message
Window := GetCapture;
if (Window <> 0) and (Message.Result = 0) then
begin
ProcessControl(GetCaptureControl, True);
if Message.Result = 0 then
Message.Result := SendMessage(Window, Msg.message, Msg.wParam,
Msg.lParam);
end;
// Allow hovered control to handle the message
Window := WindowFromPoint(Msg.pt);
if (Window <> 0) and (Message.Result = 0) then
begin
WinControl := FindControl(Window);
if WinControl = nil then
begin
// Window is a non-VCL window (e.g. a dropped down TDateTimePicker), or
// the window doesn't belong to this process
WndProc := GetWindowLongPtr(Window, GWL_WNDPROC);
Message.Result := CallWindowProc(Pointer(WndProc), Window,
Msg.message, Msg.wParam, Msg.lParam);
end
else
begin
// Window is a VCL control
// Allow non-windowed child controls to handle the message
ProcessControl(WinControl.ControlAtPos(
WinControl.ScreenToClient(Msg.pt), False), True);
// Allow native controls to handle the message
if Message.Result = 0 then
begin
WinWParamNeeded;
WinControl.DefaultHandler(Message);
end;
// Allow windowed VCL controls to handle the message
if not ((MainFormPreview and (WinControl = Application.MainForm)) or
(ActiveFormPreview and (WinControl = Screen.ActiveCustomForm)) or
(ActiveControlPreview and (WinControl = Screen.ActiveControl))) then
begin
VclWParamNeeded;
ProcessControl(WinControl, True);
end;
end;
end;
// Bypass default VCL wheel handling?
Handled := ((Message.Result <> 0) and not VclHandlingAfterHandled) or
((Message.Result = 0) and not VclHandlingAfterUnhandled);
// Modify message destination for current process
if (not Handled) and (Window <> 0) and
(GetWindowThreadProcessID(Window, OwningProcess) <> 0) and
(OwningProcess = GetCurrentProcessId) then
begin
Msg.hwnd := Window;
end;
if CancelApplicationEvents then
CancelDispatch;
end;
end;
constructor TWheelInterceptor.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
OnMessage := ApplicationMessage;
end;
procedure Activate;
begin
WheelInterceptor.Activate;
end;
{ TWheelMsgSettings }
procedure TWheelMsgSettings.RegisterMouseWheelHandler(
ControlClass: TControlClass);
begin
ControlClassList.Add(ControlClass);
end;
initialization
ControlClassList := TClassList.Create;
WheelInterceptor := TWheelInterceptor.Create(Application);
finalization
ControlClassList.Free;
end.
Отказ от ответственности:
Этот код намеренно не прокручивает что-либо, он только подготавливает маршрутизацию сообщений для событий VCL OnMouseWheel*, чтобы получить надлежащую возможность быть запущенным. Этот код не тестируется на сторонних элементах управления. Когда VclHandlingAfterHandled или VclHandlingAfterUnhandled установлено True, события мыши могут запускаться дважды. В этом посте я сделал несколько заявлений и решил, что в VCL есть три ошибки, но все они основаны на изучении документации и тестировании. Пожалуйста, проверьте это устройство и прокомментируйте выводы и ошибки. Я прошу прощения за этот довольно длинный ответ; У меня просто нет блога.
1) Наименование дерзкое взято из Одиссея Ки
2) См. Мой Центральный отчет об ошибках качества # 135258
3) См. Мой Центральный отчет об ошибках качества # 135305