如何指示鼠标滚轮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)
- 用户滚动鼠标滚轮。
- 系统将
WM_MOUSEWHEEL
消息放入前台窗口的线程的消息队列中。 - 线程的消息循环从队列中取出消息(
Application.ProcessMessage
)。 这个消息的types是TMsg
,它有一个hwnd
成员指定消息所要求的窗口句柄。 -
Application.OnMessage
事件被触发。- 设置
Handled
参数True
停止对消息的进一步处理(步骤旁边的除外)。
- 设置
-
Application.IsPreProcessMessage
方法被调用。- 如果没有控件捕获到鼠标,则调用聚焦控件的
PreProcessMessage
方法,默认情况下不执行任何操作。 VCL中没有控制权重写这个方法。
- 如果没有控件捕获到鼠标,则调用聚焦控件的
-
Application.IsHintMsg
方法被调用。- 活动提示窗口在重写
IsHintMsg
方法中处理消息。 防止消息进一步处理是不可能的。
- 活动提示窗口在重写
-
DispatchMessage
被调用。 - 焦点窗口的
TWinControl.WndProc
方法接收消息。 这个消息的types是TMessage
,它缺less窗口(因为这是调用此方法的实例)。 - 调用
TWinControl.IsControlMouseMsg
方法来检查鼠标消息是否应定向到其非窗口子控件之一。- 如果有一个已经捕获鼠标的子控件或者位于当前的鼠标位置2) ,则该消息被发送到子控件的
WndProc
方法,参见步骤10.( 2)这绝不会发生,因为WM_MOUSEWHEEL
包含鼠标在屏幕坐标中的位置,IsControlMouseMsg
假定客户端坐标(XE2)中的鼠标位置。)
- 如果有一个已经捕获鼠标的子控件或者位于当前的鼠标位置2) ,则该消息被发送到子控件的
- inheritance的
TControl.WndProc
方法接收消息。- 当系统本身不支持鼠标滚轮(<Win98或<WinNT4.0)时,该消息将转换为
CM_MOUSEWHEEL
消息并发送到CM_MOUSEWHEEL
,请参阅步骤13。 - 否则,该消息被分派到适当的消息处理程序。
- 当系统本身不支持鼠标滚轮(<Win98或<WinNT4.0)时,该消息将转换为
-
TControl.WMMouseWheel
方法接收消息。 -
WM_MOUSEWHEEL
(对系统有意义,通常也对VCL有意义)被转换为一个CM_MOUSEWHEEL
控制消息(仅对VCL有意义),它提供了方便的VCL的ShiftState
信息,而不是系统的密钥数据。 - 控件的
MouseWheelHandler
方法被调用。- 如果控件是
TCustomForm
,则调用TCustomForm.MouseWheelHandler
方法。- 如果有聚焦的控制,那么
CM_MOUSEWHEEL
被发送到聚焦的控制,见步骤14。 - 否则,调用inheritance的方法,请参阅步骤13.2。
- 如果有聚焦的控制,那么
- 否则,调用
TControl.MouseWheelHandler
方法。- 如果有一个控件捕获了鼠标,并且没有父项3) ,则根据控件的types,将消息发送到该控件,请参见步骤8或10。 ( 3)这是不会发生的,因为
Capture
是通过GetCaptureControl
得到的,它检查Parent <> nil
(XE2)。) - 如果控件在窗体上,则调用窗体的
MouseWheelHandler
,请参阅步骤13.1。 - 否则,或者如果控件是表单,则
CM_MOUSEWHEEL
被发送到控件,请参阅步骤14。
- 如果有一个控件捕获了鼠标,并且没有父项3) ,则根据控件的types,将消息发送到该控件,请参见步骤8或10。 ( 3)这是不会发生的,因为
- 如果控件是
-
TControl.CMMouseWheel
方法接收消息。-
TControl.DoMouseWheel
方法被调用。-
OnMouseWheel
事件被触发。 - 如果不处理,则根据滚动方向调用
TControl.DoMouseWheelDown
或TControl.DoMouseWheelUp
。 -
OnMouseWheelDown
或OnMouseWheelUp
事件被触发。
-
- 如果没有处理,那么
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
方法,无论怎样解决这个问题,都必须注意不要打破这种现有的定制。
本地控件可以滚动滚轮,如TMemo
, TComboBox
, TDateTimePicker
, TComboBox
, TTreeView
, TListView
等都由系统自身滚动。 发送CM_MOUSEWHEEL
到这样的控件默认情况下没有效果。 这些子类控件通过WM_MOUSEWHEEL
消息与CallWindowProc
(与VCL在TWinControl.DefaultHandler
处理)一起发送CallWindowProc
子类相关的API窗口过程而进行滚动。 奇怪的是,这个例程在调用CallWindowProc
之前没有检查Message.Result
,一旦发送了消息,就无法防止滚动。 根据控件是否能够正常滚动或控件的types,消息返回Result
集。 (例如, TMemo
返回<> 0
, TEdit
返回0
。实际滚动是否对消息结果没有影响。
VCL控件依赖于在TControl
和TWinControl
实现的默认处理,如上所述。 他们在DoMouseWheel
, DoMouseWheelDown
或DoMouseWheelUp
中DoMouseWheel
轮子事件。 据我所知,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。 当VclHandlingAfterHandled
或VclHandlingAfterUnhandled
设置为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:
-
添加
amMouseWheel
对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 (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;
这是否达到预期效果?