如何指示鼠标滚轮input来控制光标而不是聚焦?

我使用了许多滚动控件:TTreeViews,TListViews,DevExpress cxGrids和cxTreeLists等。当鼠标滚轮旋转时,带焦点的控件接收input,不pipe鼠标光标控制在什么位置。

如何将鼠标滚轮input指向控制鼠标光标的任何东西? Delphi IDE在这方面工作得非常好。

尝试覆盖您的窗体的MouseWheelHandler方法(我没有彻底testing过):

 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消息 :

鼠标滚轮旋转时发送到焦点窗口 。 DefWindowProc函数将消息传播到窗口的父级。 应该没有内部转发的消息,因为DefWindowProc传播它的父链,直到find一个窗口来处理它。

鼠标滚轮的奥德赛1)

  1. 用户滚动鼠标滚轮。
  2. 系统将WM_MOUSEWHEEL消息放入前台窗口的线程的消息队列中。
  3. 线程的消息循环从队列中取出消息( Application.ProcessMessage )。 这个消息的types是TMsg ,它有一个hwnd成员指定消息所要求的窗口句柄。
  4. Application.OnMessage事件被触发。
    1. 设置Handled参数True停止对消息的进一步处理(步骤旁边的除外)。
  5. Application.IsPreProcessMessage方法被调用。
    1. 如果没有控件捕获到鼠标,则调用聚焦控件的PreProcessMessage方法,默​​认情况下不执行任何操作。 VCL中没有控制权重写这个方法。
  6. Application.IsHintMsg方法被调用。
    1. 活动提示窗口在重写IsHintMsg方法中处理消息。 防止消息进一步处理是不可能的。
  7. DispatchMessage被调用。
  8. 焦点窗口的TWinControl.WndProc方法接收消息。 这个消息的types是TMessage ,它缺less窗口(因为这是调用此方法的实例)。
  9. 调用TWinControl.IsControlMouseMsg方法来检查鼠标消息是否应定向到其非窗口子控件之一。
    1. 如果有一个已经捕获鼠标的子控件或者位于当前的鼠标位置2) ,则该消息被发送到子控件的WndProc方法,参见步骤10.( 2)绝不会发生,因为WM_MOUSEWHEEL包含鼠标在屏幕坐标中的位置, IsControlMouseMsg假定客户端坐标(XE2)中的鼠标位置。)
  10. inheritance的TControl.WndProc方法接收消息。
    1. 当系统本身不支持鼠标滚轮(<Win98或<WinNT4.0)时,该消息将转换为CM_MOUSEWHEEL消息并发送到CM_MOUSEWHEEL ,请参阅步骤13。
    2. 否则,该消息被分派到适当的消息处理程序。
  11. TControl.WMMouseWheel方法接收消息。
  12. WM_MOUSEWHEEL (对系统有意义,通常也对VCL有意义)被转换为一个CM_MOUSEWHEEL控制消息(仅对VCL有意义),它提供了方便的VCL的ShiftState信息,而不是系统的密钥数据。
  13. 控件的MouseWheelHandler方法被调用。
    1. 如果控件是TCustomForm ,则调用TCustomForm.MouseWheelHandler方法。
      1. 如果有聚焦的控制,那么CM_MOUSEWHEEL被发送到聚焦的控制,见步骤14。
      2. 否则,调用inheritance的方法,请参阅步骤13.2。
    2. 否则,调用TControl.MouseWheelHandler方法。
      1. 如果有一个控件捕获了鼠标,并且没有父项3) ,则根据控件的types,将消息发送到该控件,请参见步骤8或10。 ( 3)这是不会发生的,因为Capture是通过GetCaptureControl得到的,它检查Parent <> nil (XE2)。)
      2. 如果控件在窗体上,则调用窗体的MouseWheelHandler ,请参阅步骤13.1。
      3. 否则,或者如果控件是表单,则CM_MOUSEWHEEL被发送到控件,请参阅步骤14。
  14. TControl.CMMouseWheel方法接收消息。
    1. TControl.DoMouseWheel方法被调用。
      1. OnMouseWheel事件被触发。
      2. 如果不处理,则根据滚动方向调用TControl.DoMouseWheelDownTControl.DoMouseWheelUp
      3. OnMouseWheelDownOnMouseWheelUp事件被触发。
    2. 如果没有处理,那么CM_MOUSEWHEEL被发送到父控件,请参阅步骤14.(我相信这是不符合MSDN在上面引用的build议,但这无疑是开发人员的一个深思熟虑的决定。可能是因为这将开始这非常连锁。)

评论,观察和考虑

几乎在这个处理链中的每一步,消息都可以被忽略,不做任何事情,通过改变消息参数来改变消息参数,通过处理消息参数来处理消息,并通过设置Handled := True或者将Message.Result设置为非零来取消消息。

只有当某个控件具有焦点时,该消息才被应用程序接收。 但是,即使当Screen.ActiveCustomForm.ActiveControl强制设置为nil ,VCL确保使用TCustomForm.SetWindowFocus进行集中控制,默认为以前的活动窗体。 (使用Windows.SetFocus(0) ,实际上不会发送消息。)

由于IsControlMouseMsg 2)中的错误, IsControlMouseMsg只能捕获鼠标,才能收到WM_MOUSEWHEEL消息。 这可以通过设置Control.MouseCapture := True 来手动实现 ,但是您必须特别注意快速释放捕获,否则会产生不需要的副作用,如需要额外的点击来完成某些操作。 此外, 鼠标捕捉通常只发生在鼠标向下和鼠标向上事件之间,但是这个限制不一定必须被应用。 但是,即使消息到达控件,它也会发送到它的MouseWheelHandler方法,该方法只是将它发送回窗体或主动控件。 因此,非窗口的VCL控件默认情况下不能对消息进行操作。 我相信这是另一个bug,否则为什么所有的轮子处理都在TControl实现? 为了这个目的,组件编写者可能已经实现了他们自己的MouseWheelHandler方法,无论怎样解决这个问题,都必须注意不要打破这种现有的定制。

本地控件可以滚动滚轮,如TMemoTComboBoxTDateTimePickerTComboBoxTTreeViewTListView等都由系统自身滚动。 发送CM_MOUSEWHEEL到这样的控件默认情况下没有效果。 这些子类控件通过WM_MOUSEWHEEL消息与CallWindowProc (与VCL在TWinControl.DefaultHandler处理)一起发送CallWindowProc子类相关的API窗口过程而进行滚动。 奇怪的是,这个例程在调用CallWindowProc之前没有检查Message.Result ,一旦发送了消息,就无法防止滚动。 根据控件是否能够正常滚动或控件的types,消息返回Result集。 (例如, TMemo返回<> 0TEdit返回0 。实际滚动是否对消息结果没有影响。

VCL控件依赖于在TControlTWinControl实现的默认处理,如上所述。 他们在DoMouseWheelDoMouseWheelDownDoMouseWheelUpDoMouseWheel轮子事件。 据我所知,VCL中的任何控件都不会重载MouseWheelHandler来处理轮子事件。

看看不同的应用程序,似乎没有标准的滚轮滚动行为的一致性。 例如:MS Word滚动hover的页面,MS Excel滚动焦点的工作簿,Windows Eplorer滚动焦点窗格,网站实现滚动行为各不相同,Evernote滚动hover的窗口等等。除了hover代码编辑器之外,自己的IDE通过滚动焦点窗口以及hover的窗口来突破所有的问题,然后代码编辑器在滚动(XE2)时窃取焦点

幸运的是,微软至less为基于Windows的桌面应用程序提供了用户体验指南 :

  • 使鼠标滚轮影响指针当前结束的控件,窗格或窗口。 这样做可以避免意想不到的结果。
  • 使鼠标滚轮无需点击或input焦点即可生效。 hover是足够的。
  • 使鼠标滚轮影响最具体的范围的对象。 例如,如果指针位于可滚动窗口内的可滚动窗格中的可滚动列表框控件的上方,则鼠标滚轮会影响列表框控件。
  • 使用鼠标滚轮时不要改变input焦点。

所以这个问题只需要滚动控制就足够了,但是Delphi的开发者并没有很容易的实现它。

结论和解决scheme

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

为了防止焦点控件滚动,控件可能不会收到CM_MOUSEWHEEL消息。 因此,任何控件的MouseWheelHandler都可能不会被调用。 因此, WM_MOUSEWHEEL可能不会被发送到任何控件。 因此唯一需要干预的地方是TApplication.OnMessage 。 此外,消息不能从中逃脱,所以所有的处理都应该在事件处理程序中进行,并且当所有默认的VCL滚轮处理都被绕过时,每个可能的条件都应该被处理。

让我们开始简单。 WindowFromPoint当前hover的窗口。

 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 ,则hover的窗口不属于应用程序的进程,或者它是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控件时,多个消息处理程序将被视为以特定顺序调用。 当鼠标位置上有一个启用的非窗口控件(typesTControl或后代)时,首先应该得到一个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控件。 例如,在拖动操作期间,创build一个临时窗口(请参阅TDragObject.DragHandle ),该窗口接收鼠标消息。 所有消息? Noooo, WM_MOUSEWHEEL不会被发送到捕获窗口,所以我们必须redirect它。 此外,当捕获窗口不处理该消息时,所有其他先前包括的处理应该发生。 这是VCL中缺less的一个function:在拖动操作期间, Form.OnMouseWheel确实被调用,但是重点控制或hover控件不会收到消息。 这意味着例如文本不能被拖到备忘录的可见部分之外的位置上的备忘录的内容中。

  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; 

这基本上是做这个工作,这是下面提出的单位的基础。 要使其工作,只需将单元名称添加到项目中的其中一个使用子句中即可。 它具有以下附加function:

  • 可以预览主窗体,活动窗体或主动控件的轮子动作。
  • 必须调用其MouseWheelHandler方法的控件类的注册。
  • 将这个TApplicationEvents对象置于所有其他对象之前的可能性。
  • 取消将OnMessage事件分派给所有其他TApplicationEvents对象的可能性。
  • 之后仍然可以进行默认的VCL处理以用于分析或testing目的。

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. 

免责声明:

这段代码故意不会滚动任何东西,它只准备VCL的OnMouseWheel*事件的消息路由,以获得适当的机会被触发。 此代码未在第三方控件上testing。 当VclHandlingAfterHandledVclHandlingAfterUnhandled设置为True ,则鼠标事件可能会被触发两次。 在这篇文章中,我提出了一些主张,并且认为VCL中存在三个错误,但是这都是基于学习文档和testing的。 请testing这个单元并评论发现和错误。 我为这个相当长的答案表示歉意。 我根本没有博客。

1)从A Key的奥德赛取名为厚脸皮

2)看到我的质量中心错误报告#135258

3)看到我的质量中心错误报告#135305

覆盖TApplication.OnMessage事件(或创buildTApplicationEvents组件),并在事件处理程序中redirectWM_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; 

它在这里工作正常,但您可能想要添加一些保护措施,以防止发生意外的情况下recursion。

您可能会发现这篇文章很有用: 使用鼠标滚轮向下滚动邮件列表框,但列表框没有焦点[1] ,它是用C#编写的,但是转换为Delphi应该不是太大的问题。 它使用钩子来实现想要的效果。

为了找出鼠标当前在哪个组件上,可以使用FindVCLWindow函数,这个例子可以在这篇文章中find: 在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

这是我一直在使用的解决scheme:

  1. 添加amMouseWheelforms单元单元的实现部分的使用条款:

     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, 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 (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是受保护的方法,因此不能从表单元文件访问,这就是为什么我定义我的类在表单元:

 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; 

正如你所看到的,它searchforms上的所有控制,不仅是直接的孩子,而是从父母到孩子的search。 在孩子们做recursionsearch会更好(但更多的代码),但上面的代码工作得很好。

为了只让一个控件响应鼠标滚轮事件,应该在执行时始终设置Handled:= true。 如果例如你有内部面板的列表框,那么面板将首先执行DoMouseWheel,如果它没有处理事件,listbox.DoMouseWheel将执行。 如果在鼠标光标下没有任何控制处理DoMouseWheel,那么重点控制就会显得比较合适。

仅适用于DevExpress控件

它适用于XE3。 它没有在其他版本上testing过。

 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; 

这是否达到预期效果?