How to direct the mouse wheel input to control under cursor instead of focused?

by

Scrolling origins

An action with the mouse wheel results in a WM_MOUSEWHEEL message being sent:

Sent to the focus window when the mouse wheel is rotated. The DefWindowProc function propagates the message to the window’s parent. There should be no internal forwarding of the message, since DefWindowProc propagates it up the parent chain until it finds a window that processes it.

A mouse wheel’s odyssey 1)

  1. The user scrolls the mouse wheel.
  2. The system places a WM_MOUSEWHEEL message into the foreground window’s thread’s message queue.
  3. The thread’s message loop fetches the message from the queue (Application.ProcessMessage). This message is of type TMsg which has a hwnd member designating the window handle the message is ment for.
  4. The Application.OnMessage event is fired.
    1. Setting the Handled parameter True stops further processing of the message (except for the next to steps).
  5. The Application.IsPreProcessMessage method is called.
    1. If no control has captured the mouse, the focused control’s PreProcessMessage method is called, which does nothing by default. No control in the VCL has overriden this method.
  6. The Application.IsHintMsg method is called.
    1. The active hint window handles the message in an overriden IsHintMsg method. Preventing the message from further processing is not possible.
  7. DispatchMessage is called.
  8. The TWinControl.WndProc method of the focused window receives the message. This message is of type TMessage which lacks the window (because that is the instance this method is called upon).
  9. The TWinControl.IsControlMouseMsg method is called to check whether the mouse message should be directed to one of its non-windowed child controls.
    1. If there is a child control that has captured the mouse or is at the current mouse position2), then the message is sent to the child control’s WndProc method, see step 10. (2) This will never happen, because WM_MOUSEWHEEL contains its mouse position in screen coordinates and IsControlMouseMsg assumes a mouse position in client coordinates (XE2).)
  10. The inherited TControl.WndProc method receives the message.
    1. When the system does not natively supports mouse wheel (< Win98 or < WinNT4.0), the message is converted to a CM_MOUSEWHEEL message and is send to TControl.MouseWheelHandler, see step 13.
    2. Otherwise the message is dispatched to the appropriate message handler.
  11. The TControl.WMMouseWheel method receives the message.
  12. The WM_MOUSEWHEEL window message (meaningful to the system and often to the VCL too) is converted to a CM_MOUSEWHEEL control message (meaningful only to the VCL) which provides for the convenient VCL’s ShiftState information instead of the system’s keys data.
  13. The control’s MouseWheelHandler method is called.
    1. If the control is a TCustomForm, then the TCustomForm.MouseWheelHandler method is called.
      1. If there is a focused control on it, then CM_MOUSEWHEEL is sent to the focused control, see step 14.
      2. Otherwise the inherited method is called, see step 13.2.
    2. Otherwise the TControl.MouseWheelHandler method is called.
      1. If there is a control that has captured the mouse and has no parent3), then the message is sent to that control, see step 8 or 10, depending on the type of the control. (3) This will never happen, because Capture is gotten with GetCaptureControl, which checks for Parent <> nil (XE2).)
      2. If the control is on a form, then the control’s form’s MouseWheelHandler is called, see step 13.1.
      3. Otherwise, or if the control ís the form, then CM_MOUSEWHEEL is sent to the control, see step 14.
  14. The TControl.CMMouseWheel method receives the message.
    1. The TControl.DoMouseWheel method is called.
      1. The OnMouseWheel event is fired.
      2. If not handled, then TControl.DoMouseWheelDown or TControl.DoMouseWheelUp is called, depending on the scroll direction.
      3. The OnMouseWheelDown or the OnMouseWheelUp event is fired.
    2. If not handled, then CM_MOUSEWHEEL is sent to the parent control, see step 14. (I believe this is against the advice given by MSDN in the quote above, but that undoubtedly is a thoughtful decision made by the developers. Possibly because that would start this very chain al over.)

Remarks, observations and considerations

At almost every step in this chain of processing the message can be ignored by doing nothing, altered by changing the message parameters, handled by acting on it, and canceled by setting Handled := True or setting Message.Result to non-zero.

Only when some control has focus, this message is received by the application. But even when Screen.ActiveCustomForm.ActiveControl is forcefully set to nil, the VCL ensures a focused control with TCustomForm.SetWindowFocus, which defaults to the previously active form. (With Windows.SetFocus(0), indeed the message is never sent.)

Due to the bug in IsControlMouseMsg 2), a TControl can only receive the WM_MOUSEWHEEL message if it has captured the mouse. This can manually be achieved by setting Control.MouseCapture := True, but you have to take special care of releasing that capture expeditiously, otherwise it will have unwanted side effects like the need for an unnecessary extra click to get something done. Besides, mouse capture typically only takes place between a mouse down and a mouse up event, but this restriction does not necessarily have to be applied. But even when the message reaches the control, it is sent to its MouseWheelHandler method which just sends it back to either the form or the active control. Thus non-windowed VCL controls can never act on the message by default. I believe this is another bug, otherwise why would all wheel handling have been implemented in TControl? Component writers may have implemented their own MouseWheelHandler method for this very purpose, and whatever solution comes to this question, there has to be taken care of not breaking this kind of existing customization.

Native controls which are capable of scrolling with the wheel, like TMemo, TListBox, TDateTimePicker, TComboBox, TTreeView, TListView, etc. are scrolled by the system itself. Sending CM_MOUSEWHEEL to such a control has no effect by default. These subclassed controls scroll as a result of the WM_MOUSEWHEEL message sent to the with the subclass associated API window procedure with CallWindowProc, which the VCL takes care of in TWinControl.DefaultHandler. Oddly enough, this routine does not check Message.Result before calling CallWindowProc, and once the message is sent, scrolling cannot be prevented. The message comes back with its Result set depending on whether the control normally is capable of scrolling or on the type of control. (E.g. a TMemo returns <> 0, and TEdit returns 0.) Whether it actually scrolled has no influence on the message result.

VCL controls rely on the default handling as implemented in TControl and TWinControl, as layed out above. They act on wheel events in DoMouseWheel, DoMouseWheelDown or DoMouseWheelUp. For as far I know, no control in the VCL has overriden MouseWheelHandler in order to handle wheel events.

Looking at different applications, there seems to be no conformity on which wheel scroll behaviour is the standard. For example: MS Word scrolls the page that is hovered, MS Excel scrolls the workbook that is focused, Windows Eplorer scrolls the focused pane, websites implement scroll behaviour each very differently, Evernote scrolls the window that is hovered, etc… And Delphi’s own IDE tops everything by scrolling the focused window as well as the hovered window, except when hovering the code editor, then the code editor steals focus when you scroll (XE2).

Luckily Microsoft offers at least user experience guidelines for Windows-based desktop applications:

  • Make the mouse wheel affect the control, pane, or window that the pointer is currently over. Doing so avoids unintended results.
  • Make the mouse wheel take effect without clicking or having input focus. Hovering is sufficient.
  • Make the mouse wheel affect the object with the most specific scope. For example, if the pointer is over a scrollable list box control in a scrollable pane within a scrollable window, the mouse wheel affects the list box control.
  • Don’t change the input focus when using the mouse wheel.

So the question’s requirement to only scroll the hovered control has enough grounds, but Delphi’s developers haven’t made it easy to implement it.

Conclusion and solution

The preferred solution is one without subclassing windows or multiple implementations for different forms or controls.

To prevent the focused control from scrolling, the control may not receive the CM_MOUSEWHEEL message. Therefore, MouseWheelHandler of any control may not be called. Therefore, WM_MOUSEWHEEL may not be send to any control. Thus the only place left for intervention is TApplication.OnMessage. Furthermore, the message may not escape from it, so all handling should take place in that event handler and when all default VCL wheel handling is bypassed, every possible condition is to be taken care of.

Let’s start simple. The enabled window which currently is hovered is gotten with 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;

With FindControl we get a reference to the VCL control. If the result is nil, then the hovered window does not belong to the application’s process, or it is a window not known to the VCL (e.g. a dropped down TDateTimePicker). In that case the message needs to be forwarded back to the API, and its result we are not interested in.

  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;

When the window ís a VCL control, multiple message handlers are to be considered calling, in a specific order. When there is an enabled non-windowed control (of type TControl or descendant) on the mouse position, it first should get a CM_MOUSEWHEEL message because that control is definitely the foreground control. The message is to be constructed from the WM_MOUSEWHEEL message and translated into its VCL equivalent. Secondly, the WM_MOUSEWHEEL message has to be send to the control’s DefaultHandler method to allow handling for native controls. And at last, again the CM_MOUSEWHEEL message has to be send to the control when no previous handler took care of the message. These last two steps cannot take place in reversed order because e.g. a memo on a scroll box must be able to scroll too.

  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;

When a window has captured the mouse, all wheel messages should be sent to it. The window retrieved by GetCapture is ensured to be a window of the current process, but it does not have to be a VCL control. E.g. during a drag operation, a temporary window is created (see TDragObject.DragHandle) that receives mouse messages. All messages? Noooo, WM_MOUSEWHEEL is not sent to the capturing window, so we have to redirect it. Furthermore, when the capturing window does not handle the message, all other previously covered processing should take place. This is a feature which is missing in the VCL: on wheeling during a drag operation, Form.OnMouseWheel indeed is called, but the focused or hovered control does not receive the message. This means for example that a text cannot be dragged into a memo’s content on a location that is beyond the visible part of the memo.

    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;

This essentially does the job, and it was the basis for the unit presented below. To get it working, just add the unit name to one of the uses clauses in your project. It has the following additional features:

  • The possibility to preview a wheel action in the main form, the active form, or the active control.
  • Registration of control classes for which their MouseWheelHandler method has to be called.
  • The possibility to bring this TApplicationEvents object in front of all others.
  • The possibility to cancel dispatching the OnMessage event to all other TApplicationEvents objects.
  • The possibility to still allow for default VCL handling afterwards for analytical or testing purposes.

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.

Disclaimer:

This code intentionally does not scroll anything, it only prepares the message routing for VCL’s OnMouseWheel* events to get the proper opportunity to get fired. This code is not tested on third-party controls. When VclHandlingAfterHandled or VclHandlingAfterUnhandled is set True, then mouse events may be fired twice. In this post I made some claims and I considered there to be three bugs in the VCL, however, that is all based on studying documentation and testing. Please do test this unit and comment on findings and bugs. I apologize for this rather long answer; I simply do not have a blog.

1) Naming cheeky taken from A Key’s Odyssey

2) See my Quality Central bug report #135258

3) See my Quality Central bug report #135305

More Related Contents:

  1. How to add mouse wheel support to a component descended from TGraphicControl?
  2. How to pass pointer to array of byte to function?
  3. Delphi: Prompt for UAC elevation when needed
  4. How can I tell if another instance of my program is already running?
  5. Why should I not use “with” in Delphi?
  6. How can I allow a form to accept file dropping without handling Windows messages?
  7. How should I prepare my 32-bit Delphi programs for an eventual 64-bit compiler? [duplicate]
  8. How to access private methods without helpers?
  9. How to send a HTTP POST Request in Delphi using WinInet api
  10. ORM for DELPHI win32
  11. How to properly free records that contain various types in Delphi at once?
  12. Delphi Conversion Unicode Issues
  13. FTP Over SSH (SFTP) In delphi 2010
  14. Creating a component with named sub-components?
  15. How to implement multiple inheritance in delphi?
  16. Is there a way to instantiate a class by its name in delphi?
  17. Could not find system file when it actually exists
  18. How to detect “dangling pointers” if “Assigned()” can’t do it?
  19. Delphi: idHttp+SSL
  20. How do I draw the selected list-box item in a different color?
  21. Delphi: How do you auto-update your applications? [closed]
  22. How do I declare an array when I don’t know the length until run time?
  23. How do I hash a string with Delphi?
  24. What is the compiler version for Delphi 2010?
  25. Delphi pre-build event not executing BEFORE compile
  26. Why are TGeneric and TGeneric incompatible types?
  27. Delphi 7: ADO, need basic coding example
  28. How to translate (internationalize, localize) application?
  29. Using TChromium, Delphi Chromium Embedded
  30. How to kill a thread in delphi?

Leave a Comment