How to disable MouseWheel if mouse is not over VirtualTreeView (TVirtualStringTree)

Question

TVirtualStringTree behaves by default if it is focused - it will scroll on mouse wheel even if mouse is not over control (except if it is over another TVirtualStringTree).

Is there a quick and elegant way to disable this behaviour?

I already did this with OnMouseWheel event and checking with PtInRect if Mouse.CursorPos if it is over a control but I have a feeling that there is a better way to do the same because this way I'd have to define a new event for each TreeView I add and also handle when to focus/unfocus the control so I hope there must be a better way to disable this.

So to be clear, I want mousewheel function to work as usual, but only when mouse is over VirtualTreeView.

Claviform

See How to add mouse wheel support to a component descended from TGraphicControl?, and How to direct the mouse wheel input to control under cursor instead of focused? – Flem

Answer 1

Drop down a TApplicationEvents control to the form

in 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;

Jabber

Unfortunately I don't like very much neither of these two solutions and I'd rather stick with my own one. I though there might be something easier already built into VirtualTreeView. I'll wait a couple more days if someone comes up with anything else, and if not, I'll accept this one as a solution. – Claviform

@coder , Yes , your intention is correct ,but unfortunately i don't think there is any easier method than the answers you got. – Jabber

@Coder, there's no feature built-in in the VT. Note that all controls behaves that way. If you will have e.g. memo on a form and you'll scroll a mouse, the scrolling will be performed even if you'll be outside of a control. That's probably why you are going to accept this post, because it affects all controls, not just a VT. – Sutherland

Thanks for added comments, I'll accept this and possibly replace my code with this. I don't like the idea of modifying original source because then I have to take care to apply all the changes every time I update VT. Thanks again! – Claviform

@Sutherland And yes, you are absolutely right it happens for other controls too so this is not a VT exclusive thing. – Claviform

This video from Embarcadero also shows this situation with mouse wheel: bit.ly/v4wPR7 – Claviform

Answer 2

Or you might try to modify the VirtualTree a bit. In the following example is used the interposed class. If you paste this code into your unit, then all of your VirtualTrees will behave this way in the form.

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;

Sutherland