Как направить вход колеса мыши на управление под курсором вместо сфокусированного?

Я использую несколько элементов управления прокруткой: TTreeViews, TListViews, DevExpress cxGrids и cxTreeLists и т. Д. Когда колесико мыши вращается, управление с фокусом получает вход независимо от того, какой контроль над курсором мыши завершен.

Как вы управляете вводом колесика мыши в любое управление курсором мыши? В этом отношении Delphi IDE работает очень хорошо.

Попробуйте переопределить метод MouseWheelHandler формы, как это (я не тестировал это полностью):

 procedure TMyForm.MouseWheelHandler(var Message: TMessage); var Control: TControl; begin Control := ControlAtPos(ScreenToClient(SmallPointToPoint(TWMMouseWheel(Message).Pos)), False, True, True); if Assigned(Control) and (Control <> ActiveControl) then begin Message.Result := Control.Perform(CM_MOUSEWHEEL, Message.WParam, Message.LParam); if Message.Result = 0 then Control.DefaultHandler(Message); end else inherited MouseWheelHandler(Message); end; 

Прокрутка

Действие с колесом мыши приводит к WM_MOUSEWHEEL сообщения WM_MOUSEWHEEL :

Отправляется в окно фокусировки при вращении колеса мыши. Функция DefWindowProc передает сообщение родительскому окну. Не должно быть внутренней пересылки сообщения, так как DefWindowProc распространяет его на родительскую цепочку, пока не найдет окно, которое его обрабатывает.

Одиссея колеса мыши 1)

  1. Пользователь прокручивает колесико мыши.
  2. Система помещает сообщение WM_MOUSEWHEEL в очередь сообщений streamа streamа переднего плана.
  3. Цикл сообщений streamа извлекает сообщение из очереди ( Application.ProcessMessage ). Это сообщение имеет тип TMsg которого есть член hwnd обозначающий дескриптор windows, для которого предназначено сообщение.
  4. Событие Application.OnMessage запущено.
    1. Установка параметра Handled True останавливает дальнейшую обработку сообщения (за исключением следующих шагов).
  5. Application.IsPreProcessMessage метод Application.IsPreProcessMessage .
    1. Если элемент управления не захватил мышь, PreProcessMessage метод PreProcessMessage сфокусированного PreProcessMessage управления, который по умолчанию ничего не делает. Никакой контроль в VCL не превзошел этот метод.
  6. Application.IsHintMsg метод Application.IsHintMsg .
    1. Активное окно подсказки обрабатывает сообщение в IsHintMsg методе IsHintMsg . Предотrotation сообщения от дальнейшей обработки невозможно.
  7. DispatchMessage .
  8. Метод TWinControl.WndProc сфокусированного windows получает сообщение. Это сообщение имеет тип TMessage которому не хватает windows (потому что это экземпляр, вызываемый этим методом).
  9. TWinControl.IsControlMouseMsg метод TWinControl.IsControlMouseMsg чтобы проверить, должно ли сообщение мыши быть направлено на один из его дочерних элементов без окон.
    1. Если есть дочерний элемент управления, который захватил мышь или находится в текущей позиции мыши 2) , тогда сообщение отправляется методу WndProc WM_MOUSEWHEEL управления, см. Шаг 10. ( 2) Этого никогда не будет, потому что WM_MOUSEWHEEL содержит свою мышь положение в координатах экрана, а IsControlMouseMsg предполагает положение мыши в координатах клиента (XE2).)
  10. Унаследованный метод TControl.WndProc получает сообщение.
    1. Когда система не поддерживает колесико мыши (CM_MOUSEWHEEL и отправляется в TControl.MouseWheelHandler , см. Шаг 13.
    2. В противном случае сообщение отправляется соответствующему обработчику сообщений.
  11. Метод TControl.WMMouseWheel получает сообщение.
  12. WM_MOUSEWHEEL w WM_MOUSEWHEEL m essage (значимый для системы и часто для VCL тоже) преобразуется в CM_MOUSEWHEEL c ontrol m essage (значимый только для VCL), который обеспечивает удобную информацию VCL ShiftState а не данные ключей системы.
  13. MouseWheelHandler метод MouseWheelHandler управления.
    1. Если TCustomForm управления является TCustomForm , то TCustomForm.MouseWheelHandler метод TCustomForm.MouseWheelHandler .
      1. Если на нем имеется сфокусированное управление, CM_MOUSEWHEEL отправляется на сфокусированное управление, см. Шаг 14.
      2. В противном случае вызывается унаследованный метод, см. Шаг 13.2.
    2. В противном случае вызывается метод TControl.MouseWheelHandler .
      1. Если есть элемент управления, который захватил мышь и не имеет родителя 3) , тогда сообщение отправляется этому элементу управления, см. Шаг 8 или 10, в зависимости от типа элемента управления. ( 3) Этого никогда не произойдет, потому что Capture GetCaptureControl с помощью GetCaptureControl , который проверяет Parent <> nil (XE2).)
      2. Если элемент управления находится в форме, MouseWheelHandler форму MouseWheelHandler формы MouseWheelHandler , см. Шаг 13.1.
      3. В противном случае, или если элемент управления является формой, CM_MOUSEWHEEL отправляется в элемент управления, см. Шаг 14.
  14. Метод TControl.CMMouseWheel получает сообщение.
    1. TControl.DoMouseWheel метод TControl.DoMouseWheel .
      1. Событие OnMouseWheel запускается.
      2. Если не обрабатывается, то вызывается TControl.DoMouseWheelDown или TControl.DoMouseWheelUp , в зависимости от направления прокрутки.
      3. OnMouseWheelDown или OnMouseWheelUp .
    2. Если не обрабатывается, CM_MOUSEWHEEL отправляется в родительский элемент управления, см. Шаг 14. (Я считаю, что это противоречит рекомендациям MSDN в приведенной выше цитате, но это, несомненно, является продуманным решением разработчиков. Возможно, потому что это начнется эта самая цепочка.)

Замечания, замечания и соображения

Почти на каждом шагу в этой цепочке обработки сообщение можно игнорировать, ничего не делая, изменяя, изменяя параметры сообщения, обрабатывая его воздействием и Message.Result установив Message.Result Handled := True или установив Message.Result в ненулевое значение.

Это сообщение принимается приложением только в том случае, если какой-либо элемент управления имеет фокус. Но даже если Screen.ActiveCustomForm.ActiveControl принудительно настроен на Screen.ActiveCustomForm.ActiveControl , VCL обеспечивает сфокусированное управление с TCustomForm.SetWindowFocus , которое по умолчанию относится к ранее активной форме. (С Windows.SetFocus(0) , действительно, сообщение никогда не отправляется.)

Из-за ошибки в IsControlMouseMsg 2) , TControl может получать WM_MOUSEWHEEL сообщение WM_MOUSEWHEEL если оно захватило мышь. Это можно сделать вручную , установив Control.MouseCapture := True , но вам нужно проявлять особую осторожность в том, чтобы быстро освободить этот захват, иначе он будет иметь нежелательные побочные эффекты, такие как необходимость лишнего дополнительного щелчка, чтобы что-то сделать. Кроме того, захват мыши обычно происходит только между нажатием мыши и событием мыши, но это ограничение необязательно необходимо применять. Но даже когда сообщение достигает MouseWheelHandler управления, оно отправляется его методу MouseWheelHandler который просто отправляет его обратно в форму или активный элемент управления. Таким образом, не-оконные элементы управления VCL никогда не могут действовать по сообщению по умолчанию. Я считаю, что это еще одна ошибка, иначе почему вся обработка колес была реализована в TControl ? Для этой цели разработчики компонентов, возможно, внедрили свой собственный метод MouseWheelHandler , и независимо от того, что решение приходит к этому вопросу, необходимо позаботиться о том, чтобы не нарушать эту существующую настройку.

Встроенные средства управления, которые можно прокручивать с помощью колеса, такие как TMemo , TListBox , TDateTimePicker , TComboBox , TTreeView , TListView и т. TTreeView , TListView самой системой. Отправка CM_MOUSEWHEEL в такой элемент управления по умолчанию не влияет. Эти подclassифицированные элементы управления прокручиваются в результате сообщения WM_MOUSEWHEEL отправленного с помощью связанной с CallWindowProc процедуры windows API с помощью CallWindowProc , которую VCL позаботится в TWinControl.DefaultHandler . Как ни странно, эта процедура не проверяет Message.Result перед вызовом CallWindowProc , и после отправки сообщения прокрутка не может быть предотвращена. Сообщение возвращается с его набором Result зависящим от того, может ли управление нормально прокручивать или управлять типом элемента управления. (Например, 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 не упростили его реализацию.

Заключение и решение

Предпочтительным решением является один без подclassов окон или нескольких реализаций для разных форм или элементов управления.

Чтобы предотвратить сфокусированное управление от прокрутки, элемент управления может не получать сообщение CM_MOUSEWHEEL . Поэтому MouseWheelHandler любого MouseWheelHandler управления не может быть вызван. Поэтому WM_MOUSEWHEEL не может быть отправлен на какой-либо элемент управления. Таким образом, единственным местом для вмешательства является TApplication.OnMessage . Кроме того, сообщение не может уйти от него, поэтому вся обработка должна выполняться в этом обработчике событий, и когда вся обработка колес VCL по умолчанию исключается, все возможные условия должны быть учтены.

Давайте начнем просто. Окно с включенным окном, которое в настоящее время WindowFromPoint с помощью 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 потому что этот элемент управления определенно является CM_MOUSEWHEEL управления переднего плана. Сообщение должно быть WM_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 ), которое принимает сообщения мыши. Все сообщения? Noooo, WM_MOUSEWHEEL не отправляется в окно захвата, поэтому мы должны перенаправить его. Кроме того, когда окно захвата не обрабатывает сообщение, должна выполняться вся другая предварительно обработанная обработка. Это функция, которая отсутствует в VCL: при Form.OnMouseWheel во время операции перетаскивания 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; 

Это по существу выполняет эту работу, и это послужило основой для представленной ниже единицы. Чтобы заставить его работать, просто добавьте имя единицы в одно из предложений о применении в вашем проекте. Он имеет следующие дополнительные возможности:

  • Возможность предварительного просмотра действия колеса в основной форме, активной форме или активном контроле.
  • Регистрация classов управления, для которых должен быть вызван их метод 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 (eg 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. 

Отказ от ответственности:

Этот код намеренно не прокручивает ничего, он только готовит маршрутизацию сообщений для событий OnMouseWheel* VCL, чтобы получить надлежащую возможность уволить. Этот код не проверяется на сторонних элементах управления. Если для параметра VclHandlingAfterHandled или VclHandlingAfterUnhandled установлено значение True , события мыши могут быть запущены дважды. В этом посте я сделал несколько утверждений, и я счел, что в VCL есть три ошибки, но все это основано на изучении документации и тестирования. Проведите тестирование этого устройства и прокомментируйте результаты и ошибки. Прошу прощения за этот довольно длинный ответ; У меня просто нет блога.

1) Называть нахальный, взятый из Одиссея Ключа

2) См. Отчет об ошибке «Центральная ошибка качества» # 135258

3) См. Отчет об ошибке «Центральная ошибка качества» # 135305

Переопределите событие TApplication.OnMessage (или создайте компонент TApplicationEvents) и перенаправьте сообщение WM_MOUSEWHEEL в обработчике событий:

 procedure TMyForm.AppEventsMessage(var Msg: tagMSG; var Handled: Boolean); var Pt: TPoint; C: TWinControl; begin if Msg.message = WM_MOUSEWHEEL then begin Pt.X := SmallInt(Msg.lParam); Pt.Y := SmallInt(Msg.lParam shr 16); C := FindVCLWindow(Pt); if C = nil then Handled := True else if C.Handle <> Msg.hwnd then begin Handled := True; SendMessage(C.Handle, WM_MOUSEWHEEL, Msg.wParam, Msg.lParam); end; end; end; 

Он отлично работает здесь, хотя вы можете захотеть добавить некоторую защиту, чтобы избежать повторения, если произойдет что-то неожиданное.

Вы можете найти эту статью полезной: отправить сообщение прокрутки вниз в список с помощью mousewheel, но listbox не имеет фокуса [1] , он написан на C #, но преобразование в Delphi не должно быть слишком большой проблемой. Он использует крючки для достижения желаемого эффекта.

Чтобы узнать, какой компонент находится в данный момент, вы можете использовать функцию FindVCLWindow, пример которой можно найти в этой статье: Получить элемент управления под мышью в приложении Delphi [2] .

[1] http://social.msdn.microsoft.com/forums/en-US/winforms/thread/ec1fbfa2-137e-49f6-b444-b634e4f44f21/
[2] http://delphi.about.com/od/delphitips2008/qt/find-vcl-window.htm

Это решение, которое я использовал:

  1. Добавьте amMouseWheel в раздел uses раздела реализации единицы формы после блока forms :

     unit MyUnit; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, // Fix and util for mouse wheel amMouseWheel; ... 
  2. Сохраните следующий код в amMouseWheel.pas :

     unit amMouseWheel; // ----------------------------------------------------------------------------- // The original author is Anders Melander, [email protected], http://melander.dk // Copyright © 2008 Anders Melander // ----------------------------------------------------------------------------- // License: // Creative Commons Attribution-Share Alike 3.0 Unported // http://creativecommons.org/licenses/by-sa/3.0/ // ----------------------------------------------------------------------------- interface uses Forms, Messages, Classes, Controls, Windows; //------------------------------------------------------------------------------ // // TForm work around for mouse wheel messages // //------------------------------------------------------------------------------ // The purpose of this class is to enable mouse wheel messages on controls // that doesn't have the focus. // // To scroll with the mouse just hover the mouse over the target control and // scroll the mouse wheel. //------------------------------------------------------------------------------ type TForm = class(Forms.TForm) public procedure MouseWheelHandler(var Msg: TMessage); override; end; //------------------------------------------------------------------------------ // // Generic control work around for mouse wheel messages // //------------------------------------------------------------------------------ // Call this function from a control's (eg a TFrame) DoMouseWheel method like // this: // // function TMyFrame.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; // MousePos: TPoint): Boolean; // begin // Result := ControlDoMouseWheel(Self, Shift, WheelDelta, MousePos) or inherited; // end; // //------------------------------------------------------------------------------ function ControlDoMouseWheel(Control: TControl; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; implementation uses Types; procedure TForm.MouseWheelHandler(var Msg: TMessage); var Target: TControl; begin // Find the control under the mouse Target := FindDragTarget(SmallPointToPoint(TCMMouseWheel(Msg).Pos), False); while (Target <> nil) do begin // If the target control is the focused control then we abort as the focused // control is the originator of the call to this method. if (Target = Self) or ((Target is TWinControl) and (TWinControl(Target).Focused)) then begin Target := nil; break; end; // Let the target control process the scroll. If the control doesn't handle // the scroll then... Msg.Result := Target.Perform(CM_MOUSEWHEEL, Msg.WParam, Msg.LParam); if (Msg.Result <> 0) then break; // ...let the target's parent give it a go instead. Target := Target.Parent; end; // Fall back to the default processing if none of the controls under the mouse // could handle the scroll. if (Target = nil) then inherited; end; type TControlCracker = class(TControl); function ControlDoMouseWheel(Control: TControl; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; var Target: TControl; begin (* ** The purpose of this method is to enable mouse wheel messages on controls ** that doesn't have the focus. ** ** To scroll with the mouse just hover the mouse over the target control and ** scroll the mouse wheel. *) Result := False; // Find the control under the mouse Target := FindDragTarget(MousePos, False); while (not Result) and (Target <> nil) do begin // If the target control is the focused control then we abort as the focused // control is the originator of the call to this method. if (Target = Control) or ((Target is TWinControl) and (TWinControl(Target).Focused)) then break; // Let the target control process the scroll. If the control doesn't handle // the scroll then... Result := TControlCracker(Target).DoMouseWheel(Shift, WheelDelta, MousePos); // ...let the target's parent give it a go instead. Target := Target.Parent; end; end; end. 

У меня была такая же проблема, и я решил ее немного взломать, но она работает.

Я не хотел возиться с сообщениями и решил просто вызвать метод DoMouseWheel для управления, который мне нужен. Взлом заключается в том, что метод DoMouseWheel защищен и поэтому недоступен из файла формы модуля, поэтому я определил свой class в модуле формы:

 TControlHack = class(TControl) end; //just to call DoMouseWheel 

Затем я написал обработчик событий TForm1.onMouseWheel:

 procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); var i: Integer; c: TControlHack; begin for i:=0 to ComponentCount-1 do if Components[i] is TControl then begin c:=TControlHack(Components[i]); if PtInRect(c.ClientRect,c.ScreenToClient(MousePos)) then begin Handled:=c.DoMouseWheel(shift,WheelDelta,MousePos); if Handled then break; end; end; end; 

Как вы видите, он ищет все элементы управления в форме, а не только ближайшие дети, и оказывается, чтобы искать от родителей к детям. Было бы лучше (но больше кода) сделать рекурсивный поиск у детей, но код выше работает отлично.

Чтобы только один элемент управления реагировал на событие mousewheel, вы всегда должны установить Handled: = true, когда он будет реализован. Если, например, у вас есть панель ввода внутри панели, панель сначала выполнит DoMouseWheel, и если она не обрабатывает событие, будет выполняться listbox.DoMouseWheel. Если контроль над курсором мыши не обработан DoMouseWheel, то сфокусированный элемент управления будет казаться довольно адекватным.

Только для использования с элементами управления DevExpress

Он работает на XE3. Он не тестировался в других версиях.

 procedure TMainForm.DoApplicationMessage(var AMsg: TMsg; var AHandled: Boolean); var LControl: TWinControl; LMessage: TMessage; begin if AMsg.message <> WM_MOUSEWHEEL then Exit; LControl := FindVCLWindow(AMsg.pt); if not Assigned(LControl) then Exit; LMessage.WParam := AMsg.wParam; // see TControl.WMMouseWheel TCMMouseWheel(LMessage).ShiftState := KeysToShiftState(TWMMouseWheel(LMessage).Keys); LControl.Perform(CM_MOUSEWHEEL, LMessage.WParam, AMsg.lParam); AHandled := True; end; 

если вы не используете элементы управления DevExpress, затем выполните -> SendMessage

 SendMessage(LControl.Handle, AMsg.message, AMsg.WParam, AMsg.lParam); 

В событии OnMouseEnter для каждого прокручиваемого элемента управления добавьте соответствующий вызов SetFocus

Итак, для ListBox1:

 procedure TForm1.ListBox1MouseEnter(Sender: TObject); begin ListBox1.SetFocus; end; 

Достигает ли это желаемого эффекта?

Interesting Posts

Что нужно делать JVM при вызове метода native?

Где регистрируются результаты работы утилиты проверки диска XP?

Как попасть на экран блокировки Windows 8 на Microsoft Surface?

Избегайте, чтобы Android Lint жаловался на непереведенную строку

Объявление 64-битных переменных в C

Как работают магнитные ссылки BitTorrent?

Можно ли загрузить всю папку с помощью FTP?

Если пароль менее логин не рекомендуется для коммерческих сайтов, что было бы лучшим вариантом для этого без взаимодействия?

Как печатать строки с разрывами строк в java

Совместное использование листа Excel через сеть?

Поворот изображения в java на указанный угол

‘WebForm_DoPostBackWithOptions’ не определен в IE11 Preview

Развертывание идентичной настройки Windows на нескольких компьютерах

Получение сценариев .py для открытия в IDLE Python

Любой способ получить первые несколько символов имени файла в пакетном файле DOS

Давайте будем гением компьютера.