如果鼠标不在 VirtualTreeView (TVirtualStringTree) 上，如何禁用 MouseWheel

Question

如果 TVirtualStringTree 获得焦点，则默认情况下它会在鼠标滚轮上滚动，即使鼠标未超出控制范围（除非它位于另一个 TVirtualStringTree 上方）。

有没有一种快速而优雅的方法来禁用这种行为？

我已经使用 OnMouseWheel 事件执行此操作，并使用 PtInRect 检查 Mouse.CursorPos 是否在控件上，但我有一种感觉一个更好的方法来做同样的事情，因为这样我必须为我添加的每个 TreeView 定义一个新事件，并且还要处理何时聚焦/取消聚焦控件，所以我希望必须有更好的方法来禁用它。

因此，需要明确的是，我希望鼠标滚轮功能能够像往常一样工作，但仅当鼠标位于 VirtualTreeView 上时才有效。

Answer 1

表单

将 TApplicationEvents 控件下拉到TApplicationEvents onMessage 中的

 procedure TForm5.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
 var
  pnt: TPoint;
  ctrl: TWinControl;
 begin
  if Msg.message = WM_MOUSEWHEEL then
  begin
    if not GetCursorPos(pnt) then Exit;
    ctrl := FindVCLWindow(pnt);
    if Assigned(ctrl) then
      Msg.hwnd := ctrl.Handle;
  end;
 end;

Answer 2

或者您可以尝试稍微修改 VirtualTree。在下面的示例中使用了插入类。如果您将此代码粘贴到您的单元中，那么您的所有 VirtualTree 都将在表单中以这种方式运行。

uses
  VirtualTrees;

type
  TVirtualStringTree = class(VirtualTrees.TVirtualStringTree)
  private
    FMouseInside: Boolean;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL;
  end;

implementation

procedure TVirtualStringTree.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  // SetFocus will set the focus to the tree which is entered by mouse
  // but it's probably what you don't want to, if so, just remove the
  // following line. If you want to scroll the tree under mouse without
  // stealing the focus from the previous control then this is not the
  // right way - the tree must either be focused or you can steal it by
  // the SetFocus. This only resolves the case when you have a focused
  // tree and leave it with the mouse, then no scrolling is performed,
  // if you enter it, you can scroll again.
  SetFocus;
  // set the flag which tells about mouse inside
  FMouseInside := True;
end;

procedure TVirtualStringTree.CMMouseLeave(var Message: TMessage);
begin
  // reset the flag about mouse inside
  FMouseInside := False;
  inherited;
end;

procedure TVirtualStringTree.CMMouseWheel(var Message: TCMMouseWheel);
begin
  // if mouse is inside then let's wheel the mouse otherwise nothing
  if FMouseInside then
    inherited;
end;