我创建了一个delphi组件，它来自TGraphicControl。是否可以添加对鼠标滚轮的支持？
---编辑---
我已经公开了MouseWheel事件，如下所示但是没有调用它们。
TMyComponent = class(TGraphicControl)
published
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
end;
---编辑---
如下所示，我试图捕获WM_MOUSEWHEEL和CM_MOUSEWHEEL消息，但它似乎不起作用。但是我设法捕获了CM_MOUSEENTER消息。我不明白为什么我可以捕获一种类型的消息，而不是另一种消息。
答案 0 :(得分：4)
由于有几个VCL结构（无论是故意的实现选择还是可能是错误 1），我都在中间）只有聚焦控件及其所有父母都得到鼠标滚轮消息，如以及捕获鼠标的控件，并且有一个专注的父母。
在TControl级别，可以强制执行后一种情况。当鼠标进入控件的客户端空间时，控件从VCL接收CM_MOUSEENTER消息。要强制它接收鼠标滚轮消息，请将其父项聚焦并将鼠标捕获到该消息处理程序中：
procedure TWheelControl.CMMouseEnter(var Message: TMessage);
begin
FPrevFocusWindow := SetFocus(Parent.Handle);
MouseCapture := True;
inherited;
end;
但是当鼠标退出控件时，必须撤消这些设置。由于控件现在正在捕获鼠标，因此它不会收到CM_MOUSELEAVE，因此您必须手动检查它，例如在WM_MOUSEMOVE消息处理程序中：
procedure TWheelControl.WMMouseMove(var Message: TWMMouseMove);
begin
if MouseCapture and
not PtInRect(ClientRect, SmallPointToPoint(Message.Pos)) then
begin
MouseCapture := False;
SetFocus(FPrevFocusWindow);
end;
inherited;
end;
现在，您可以假设控件收到的滚轮消息随后将触发OnMouseWheel，OnMouseWheelDown和OnMouseWheelUp事件。但是，不需要再进行一次干预。消息进入MouseWheelHandler中的控件，恰好将消息传递给表单或活动控件。要触发这些事件，应发送CM_MOUSEWHEEL控制消息：
procedure TWheelControl.MouseWheelHandler(var Message: TMessage);
begin
Message.Result := Perform(CM_MOUSEWHEEL, Message.WParam, Message.LParam);
if Message.Result = 0 then
inherited MouseWheelHandler(Message);
end;
这导致最终的代码：
unit WheelControl;
interface
uses
System.Classes, Winapi.Windows, Winapi.Messages, Vcl.Controls;
type
TWheelControl = class(TGraphicControl)
private
FPrevFocusWindow: HWND;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
public
procedure MouseWheelHandler(var Message: TMessage); override;
published
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
end;
implementation
{ TWheelControl }
procedure TWheelControl.CMMouseEnter(var Message: TMessage);
begin
FPrevFocusWindow := SetFocus(Parent.Handle);
MouseCapture := True;
inherited;
end;
procedure TWheelControl.MouseWheelHandler(var Message: TMessage);
begin
Message.Result := Perform(CM_MOUSEWHEEL, Message.WParam, Message.LParam);
if Message.Result = 0 then
inherited MouseWheelHandler(Message);
end;
procedure TWheelControl.WMMouseMove(var Message: TWMMouseMove);
begin
if MouseCapture and
not PtInRect(ClientRect, SmallPointToPoint(Message.Pos)) then
begin
MouseCapture := False;
SetFocus(FPrevFocusWindow);
end;
inherited;
end;
end.
如您所见，这会改变聚焦控制，这会对抗user experience guidelines for Windows-based desktop applications，并且当聚焦控件具有明确的聚焦状态时，可能会导致视觉干扰。
作为替代方案，您可以通过覆盖Application.OnMessage来绕过所有默认的VCL鼠标滚轮处理并在那里处理它。这可以按如下方式完成：
unit WheelControl2;
interface
uses
System.Classes, Winapi.Windows, Winapi.Messages, Vcl.Controls, Vcl.AppEvnts,
Vcl.Forms;
type
TWheelControl = class(TGraphicControl)
published
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
end;
implementation
type
TWheelInterceptor = class(TCustomApplicationEvents)
private
procedure ApplicationMessage(var Msg: tagMSG; var Handled: Boolean);
public
constructor Create(AOwner: TComponent); override;
end;
procedure TWheelInterceptor.ApplicationMessage(var Msg: tagMSG;
var Handled: Boolean);
var
Window: HWND;
WinControl: TWinControl;
Control: TControl;
Message: TMessage;
begin
if Msg.message = WM_MOUSEWHEEL then
begin
Window := WindowFromPoint(Msg.pt);
if Window <> 0 then
begin
WinControl := FindControl(Window);
if WinControl <> nil then
begin
Control := WinControl.ControlAtPos(WinControl.ScreenToClient(Msg.pt),
False);
if Control <> nil then
begin
Message.WParam := Msg.wParam;
Message.LParam := Msg.lParam;
TCMMouseWheel(Message).ShiftState :=
KeysToShiftState(TWMMouseWheel(Message).Keys);
Message.Result := Control.Perform(CM_MOUSEWHEEL, Message.WParam,
Message.LParam);
Handled := Message.Result <> 0;
end;
end;
end;
end;
end;
constructor TWheelInterceptor.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
OnMessage := ApplicationMessage;
end;
initialization
TWheelInterceptor.Create(Application);
end.
小心将Handled事件的MouseWheel*参数设置为True，否则焦点控件也会滚动。
有关鼠标滚轮处理的更多背景信息以及更通用的解决方案，另请参阅How to direct the mouse wheel input to control under cursor instead of focused?。
1）请参阅Quality Central bug report #135258和Quality Central bug report #135305。
答案 1 :(得分：3)
TGraphicControl来自TControl，已经有鼠标滚轮支持。请参阅wm_MouseWheel消息，DoMouseWheel，DoMouseWheelDown，DoMouseWheelUp和MouseWheelHandler方法以及WheelAccumulator属性。
答案 2 :(得分：1)
只有TWinControl后代可以接收鼠标滚轮消息。 TGraphicControl不是基于Window的控件，因此不能。如果VCL将消息路由到TGraphicControl，它可以工作，但显然没有。你可以从TCustomControl下载，然后就可以了。
答案 3 :(得分：1)
我有同样的问题。没有运气找到解决方案，但也许这将有所帮助：
我怀疑其他组件是 调用Win API方法SetCapture， 根据API的帮助：
“SetCapture函数设置 鼠标捕获到指定的窗口 属于当前线程。一旦 一个窗口捕获了鼠标，全部 鼠标输入指向那个 窗口，无论是否 光标位于其边界内 窗口。一次只能有一个窗口 抓住鼠标。 “
作为新用户，我无法发布完整帖子的链接。
EDITED
如果您从TCustomControl创建组件作为后代，您可以解决您的问题，如下所述：
答案 4 :(得分：0)
捕获WM_MOUSEWHEEL消息。
答案 5 :(得分：0)
我正在使用以下技术，我订阅了表单事件MouseWheelUp()，在其中，我用WindowFromPoint()（win32 api函数）和Vcl.Controls.FindControl()搜索了小部件，然后我检查我是否有正确的UI窗口小部件，如果没有，请检查ActiveControl（当前具有焦点的表单上的小部件）。
这项技术可确保当小部件位于光标下方或不在光标下方但具有 focus 时，鼠标滚轮向上/向下事件有效。
下面的示例对鼠标滚轮向上事件做出反应，当TSpinEdit在光标下方或具有焦点时，将TSpinEdit递增。
function TFormOptionsDialog.FindSpinEdit(const AMousePos: TPoint): TSpinEdit;
var
LWindow: HWND;
LWinControl: TWinControl;
begin
Result := nil;
LWindow := WindowFromPoint(AMousePos);
if LWindow = 0 then
Exit;
LWinControl := FindControl(LWindow);
if LWinControl = nil then
Exit;
if LWinControl is TSpinEdit then
Exit(LWinControl as TSpinEdit);
if LWinControl.Parent is TSpinEdit then
Exit(LWinControl.Parent as TSpinEdit);
if ActiveControl is TSpinEdit then
Exit(ActiveControl as TSpinEdit);
end;
procedure TFormOptionsDialog.FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint;
var Handled: Boolean);
var
LSpinEdit: TSpinEdit;
begin
LSpinEdit := FindSpinEdit(MousePos);
if LSpinEdit = nil then
Exit;
LSpinEdit.Value := LSpinEdit.Value + LSpinEdit.Increment;
Handled := True;
end;