如何引导鼠标滚轮输入在光标下控制而不是聚焦？

Posted 2023-04-13

技术标签:

【中文标题】如何引导鼠标滚轮输入在光标下控制而不是聚焦？【英文标题】：How to direct the mouse wheel input to control under cursor instead of focused? 【发布时间】：2011-01-16 02:23:25 【问题描述】：

我使用了一些滚动控件：TTreeViews、TListViews、DevExpress cxGrids 和 cxTreeLists 等。当鼠标滚轮旋转时，无论鼠标光标在哪个控件上，具有焦点的控件都会接收输入。

如何将鼠标滚轮输入指向鼠标光标所在的任何控件？ Delphi IDE 在这方面做得很好。

【问题讨论】：

***.com/questions/5297234/… 相关：***.com/questions/34145952/… 【参考方案1】：

滚动来源

使用鼠标滚轮的操作会导致发送WM_MOUSEWHEEL message：

鼠标滚轮旋转时发送到焦点窗口。 DefWindowProc 函数将消息传播到窗口的父级。不应有消息的内部转发，因为 DefWindowProc 将其向上传播到父链，直到找到处理它的窗口。

鼠标滚轮的奥德赛¹⁾

WM_MOUSEWHEEL

Application.ProcessMessage

TMsg

hwnd

Application.OnMessage

Handled

True

Application.IsPreProcessMessage

PreProcessMessage

Application.IsHintMsg

IsHintMsg

DispatchMessage

TWinControl.WndProc

TMessage

TWinControl.IsControlMouseMsg

²⁾

WndProc

²⁾

永远不会

WM_MOUSEWHEEL

IsControlMouseMsg

TControl.WndProc

CM_MOUSEWHEEL消息发送到TControl.MouseWheelHandler，见步骤13。

TControl.WMMouseWheel

WM_MOUSEWHEEL

CM_MOUSEWHEEL

ShiftState

MouseWheelHandler

TCustomForm

TCustomForm.MouseWheelHandler

CM_MOUSEWHEEL

TControl.MouseWheelHandler

³⁾

永远不会

Capture

GetCaptureControl

Parent <> nil

MouseWheelHandler

CM_MOUSEWHEEL

TControl.CMMouseWheel

TControl.DoMouseWheel

OnMouseWheel

TControl.DoMouseWheelDown

TControl.DoMouseWheelUp

OnMouseWheelDown

OnMouseWheelUp

CM_MOUSEWHEEL

备注、观察和注意事项

在这个处理链中的几乎每一步，消息都可以通过什么都不做来忽略，通过更改消息参数进行更改，通过对其进行操作来处理，并通过设置Handled := True 或将Message.Result 设置为非零来取消.

仅当某个控件具有焦点时，应用程序才会收到此消息。但即使Screen.ActiveCustomForm.ActiveControl 被强制设置为nil，VCL 也可以确保使用TCustomForm.SetWindowFocus 进行集中控制，默认为以前的活动形式。（使用Windows.SetFocus(0)，确实消息永远不会发送。）

由于IsControlMouseMsg ²⁾ 中的错误，TControl 只能在捕获鼠标的情况下接收WM_MOUSEWHEEL 消息。 This can manually be achieved 通过设置Control.MouseCapture := True，但您必须特别注意迅速释放该捕获，否则它将产生不必要的副作用，例如需要不必要的额外点击才能完成某事。此外，mouse capture 通常只发生在鼠标按下和鼠标按下事件之间，但不一定必须应用此限制。但即使消息到达控件，它也会被发送到其MouseWheelHandler 方法，该方法只是将其发送回表单或活动控件。因此，默认情况下，非窗口 VCL 控件永远不会对消息起作用。我相信这是另一个错误，否则为什么所有车轮处理都已在TControl 中实现？组件编写者可能为此目的实现了他们自己的 MouseWheelHandler 方法，无论解决这个问题，都必须注意不要破坏这种现有的自定义。

原生控件可以滚动滚动，如TMemo、TListBox、TDateTimePicker、TComboBox、TTreeView、TListView等由系统本身。默认情况下，向这样的控件发送CM_MOUSEWHEEL 无效。这些子类控件滚动是由于WM_MOUSEWHEEL 消息发送到带有CallWindowProc 的子类关联API 窗口过程的结果，VCL 在TWinControl.DefaultHandler 中负责处理。奇怪的是，这个例程在调用CallWindowProc 之前并没有检查Message.Result，而且一旦发送消息，就无法阻止滚动。该消息返回其Result 设置取决于控件通常是否能够滚动或控件类型。（例如TMemo返回<> 0，TEdit返回0。）是否实际滚动对消息结果没有影响。

VCL 控件依赖于TControl 和TWinControl 中实现的默认处理，如上所示。它们作用于DoMouseWheel、DoMouseWheelDown 或DoMouseWheelUp 中的车轮事件。据我所知，VCL 中的任何控件都没有覆盖MouseWheelHandler 来处理车轮事件。

查看不同的应用程序，似乎没有一致的滚轮滚动行为是标准。例如：MS Word 滚动悬停的页面，MS Excel 滚动聚焦的工作簿，Windows Eplorer 滚动聚焦的窗格，网站实现的滚动行为各不相同，Evernote 滚动悬停的窗口，等等……还有 Delphi 的自己的 IDE 通过滚动焦点窗口以及悬停的窗口来将所有内容置于首位，除非悬停代码编辑器，然后代码编辑器在滚动时 窃取焦点 (XE2)。

幸运的是微软至少提供user experience guidelines for Windows-based desktop applications：

使鼠标滚轮影响指针当前所在的控件、窗格或窗口。这样做可以避免意外结果。 使鼠标滚轮在不点击或输入焦点的情况下生效。悬停即可。 使鼠标滚轮影响具有最特定范围的对象。例如，如果指针位于可滚动窗口内的可滚动窗格中的可滚动列表框控件上，则鼠标滚轮会影响列表框控件. 使用鼠标滚轮时不要更改输入焦点。

所以这个问题要求只滚动悬停的控件有足够的理由，但是 Delphi 的开发人员并没有让它变得容易实现。

结论及解决办法

首选的解决方案是没有子类化窗口或针对不同窗体或控件的多个实现。

为防止焦点控件滚动，控件可能不会收到CM_MOUSEWHEEL 消息。因此，不能调用任何控件的MouseWheelHandler。因此，WM_MOUSEWHEEL 可能不会发送到任何控件。因此，唯一需要干预的地方是TApplication.OnMessage。此外，消息可能无法从中逃脱，因此所有处理都应在该事件处理程序中进行，并且当绕过所有默认 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 中存在三个错误，但是，这都是基于研究文档和测试。请测试这个单元并评论发现和错误。我为这个相当长的答案道歉；我根本没有博客。

¹⁾ 命名厚颜无耻取自A Key’s Odyssey

²⁾ 见我的Quality Central bug report #135258

³⁾ 见我的Quality Central bug report #135305

【讨论】：

"发送到焦点窗口时..." vs. "..线程的消息循环从队列中获取消息..." 我想知道为什么文档坚持认为消息是已发送（也是here），而显然情况并非如此。 "消息返回结果集..." RTL 在classes.StdWndProc 中将每个发送的消息的结果设置为0 , 在调用目标窗口过程之前。 @Ser documentation 确实解释了两种不同的消息路由方法，但我相信他们为了简单起见更喜欢使用同义词，因为每次文档提到时都要给出一个摘要发送不利于可读性。但实际上，Windows 桌面程序员应该意识到例如PostMessage 和 SendMessage. @Ser 这里，我说的是TWinControl.DefaultHandler 调用期间的消息结果类型，这是消息传递的最后一个例程，远远超过了使用Classes.StdWndProc 创建的时间。这是 *** 上最长的答案吗？我不抱怨。很高兴它以一个具体的答案结束。【参考方案2】：

尝试像这样覆盖表单的 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;

【讨论】：

几乎可以工作了。 ControlAtPos() 获取直接子级，因此如果控件在面板中，则返回面板。 FindVCLWindow(Mouse.CursorPos) 返回正确的控件。只是 DevExpress TcxTreeList 滚动太多 - 似乎滚动了 3 倍。事实证明这是对我有用的解决方案。过度滚动的解决方案是设置 Message.Result := 1。将注意 FindVCLWindow 的限制。感谢您的帮助。由于某种原因，当我在 TMyForm 上方滚动时，此代码会产生 *** 当 MouseWheelHandler 函数是传递给的 Control 的 MouseWheelHandler 时，此代码可以在正确的情况下生成 ***。我通过在我的表单中添加一个“ScrollControl”变量来解决这个问题，该变量在调用“Perform”之前设置，并与 ActiveControl 一起检查，因此它不会无限递归。最后也应该设置为 nil。这给了我一个堆栈溢出，也没有成功。 Zoe 下面的答案有效，但并不完全。它不会滚动 TScrollBox，当 TDBGrid 有焦点时，它无论如何都会捕获焦点。【参考方案3】：

覆盖 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;

它在这里工作正常，但您可能需要添加一些保护以保持如果发生意外情况，它不会递归。

【讨论】：

我认为这是最好的答案。问题是集中的 DevExpress 控件仍然截获此消息。如果我调用 C.Perform() 而不是 SendMessage()，那么 DevExpress 控件可以工作，但通用控件不能。必须在 DevExpress 源代码中进行一些挖掘才能禁用此钩子。我最终放弃了这个解决方案，因为似乎专注的 TControl（与 DevExpress 无关）总是拦截消息。这是我能找到的最接近的，但仍然不起作用。如前所述，无论如何，聚焦控件总是会滚动。例如，即使 TDBGrid 具有焦点，但鼠标正在滚动其他内容，它仍会滚动 TDBGrid。我注意到这适用于 XE8，但不适用于 10 Seattle，至少在我的环境中。【参考方案4】：

您可能会发现这篇文章很有用：send a scroll down message to listbox using mousewheel, but listbox doesn't have focus [1]，它是用 C# 编写的，但转换为 Delphi 应该不是什么大问题。它使用钩子来实现想要的效果。

要找出鼠标当前在哪个组件上，您可以使用 FindVCLWindow 函数，可以在这篇文章中找到一个示例：Get the Control Under the Mouse in a Delphi application [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

【讨论】：

【参考方案5】：

这是我一直在使用的解决方案：

将amMouseWheel 添加到表单单元的实现部分的uses 子句中在 forms 单元之后：

unit MyUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  // Fix and util for mouse wheel
  amMouseWheel;
...

将以下代码保存到amMouseWheel.pas：

unit amMouseWheel;

// -----------------------------------------------------------------------------
// The original author is Anders Melander, anders@melander.dk, 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 (e.g. 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.

【讨论】：

这对我没有任何帮助。 @JerryDodge 在我使用它的任何地方都对我很好，而且我从其他人那里听说它也对他们有用。我无法真正评论为什么它对你不起作用，因为你没有描述你做了什么。您应该发布一个新问题，详细说明您的特定要求和问题。我说得太早了，忘了回来编辑，抱歉。它有效，但不完全。核心问题是，如果另一个控件当前有焦点，它仍然会滚动，例如TDBGrid（在我们的应用程序中广泛使用）。所以我最终得到了两个同时滚动的控件。实际上，我在这个问题上开始了赏金，因为提出一个新问题只会被标记为这个问题的重复。 @JerryDodge 什么版本的德尔福？您使用的是TForm.MouseWheelHandler 解决方案还是ControlDoMouseWheel() 解决方案？尝试在Perform(CM_MOUSEWHEEL)/DoMouseWheel() 调用处放置一个断点。目标是否返回正确的值（即表明它处理了事件的值）？如果目标返回不正确的值，那么您将得到您所看到的症状。【参考方案6】：

我遇到了同样的问题，并通过一些小技巧解决了它，但它确实有效。

我不想乱用消息，决定只调用 DoMouseWheel 方法来控制我需要的。哈克是 DoMouseWheel 是受保护的方法，因此无法从表单单元文件中访问，这就是我在表单单元中定义我的类的原因：

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;

如您所见，它搜索表单上的所有控件，不仅是直接子项，而且结果是从父项到子项进行搜索。对孩子进行递归搜索会更好（但代码更多），但上面的代码工作得很好。

要使只有一个控件响应鼠标滚轮事件，您应该在实现时始终设置 Handled:=true。例如，如果您在面板中有列表框，则面板将首先执行 DoMouseWheel，如果它没有处理事件，则将执行 listbox.DoMouseWheel。如果鼠标光标下没有控件处理 DoMouseWheel，则焦点控件将，这似乎是相当合适的行为。

【讨论】：

谢谢，但这没有帮助。与我在其他答案的 cmets 中描述的问题相同。至少我认为你没有得到堆栈溢出（这在这段代码中是不可能的）。滚动框是否按应有的方式工作？【参考方案7】：

仅适用于 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 控件，那么 Perform -> SendMessage

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

【讨论】：

【参考方案8】：

在每个可滚动控件的 OnMouseEnter 事件中添加对 SetFocus 的相应调用

所以对于 ListBox1：

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

这样能达到预期的效果吗？

【讨论】：

不，这对程序来说是不好的行为。这将改变服务器的用户体验。不是每个人都使用 X 窗口管理器，您可以在其中移动鼠标以将焦点集中到不同的窗口。这将是一个糟糕的用户体验。专注意味着很多。只有用户才能决定何时设置焦点。

以上是关于如何引导鼠标滚轮输入在光标下控制而不是聚焦？的主要内容，如果未能解决你的问题，请参考以下文章

为啥谷歌浏览器，鼠标滚轮可以向下滚，但是不能向上滚，很不爽。

网页不能用鼠标滚轮控制滚动条我鼠标滚轮上下滚动。。但网页没反应。这是怎么回事。。怎么修复。。

鼠标滚轮自己有时会自动滚的啊

JS怎么禁止鼠标滚轮的单击 IE下！注意是滚轮去单击而不是滚动！

在Delphi中怎样抓取鼠标形状

监听鼠标滚轮（js+jq），xp系统下也OK

如何引导鼠标滚轮输入在光标下控制而不是聚焦？

滚动来源

鼠标滚轮的奥德赛1)

备注、观察和注意事项

结论及解决办法

ScrollAnywhere.pas

鼠标滚轮的奥德赛¹⁾