7

TVirtualStringTreeは、フォーカスされている場合、デフォルトで動作します。マウスが制御されていない場合でも（別のTVirtualStringTree上にある場合を除く）、マウスホイール上でスクロールします。

この動作を無効にするための迅速でエレガントな方法はありますか？

私はすでにOnMouseWheelイベントでこれを行い、それがコントロール上にあるPtInRectかMouse.CursorPosどうかを確認しましたが、追加するTreeViewごとに新しいイベントを定義する必要があるため、同じことを行うためのより良い方法があると感じています。コントロールをフォーカス/フォーカス解除するタイミングを処理するので、これを無効にするより良い方法があるはずです。

したがって、明確にするために、マウスがVirtualTreeView上にある場合にのみ、mousewheel関数を通常どおりに機能させたいと思います。

4

2 に答える 2

3

TApplicationEventsコントロールをフォームにドロップダウンします

TApplicationEventsonMessageで

 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;
于 2011-12-02T04:18:07.460 に答える
3

または、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;
于 2011-12-02T07:43:20.687 に答える