マウスホイールの入力を、フォーカスではなくカーソルの下のコントロールに向ける方法は？

Question

TTreeViews、TListViews、DevExpress cxGrids、cxTreeListsなど、いくつかのスクロールコントロールを使用しています。マウスホイールを回転させると、マウスカーソルがどのコントロール上にあるかに関係なく、フォーカスのあるコントロールが入力を受け取ります。

マウスカーソルが置かれているコントロールにマウスホイール入力をどのように向けますか？ Delphi IDEは、この点で非常にうまく機能します。

Answer 1

次のようにフォームのMouseWheelHandlerメソッドをオーバーライドしてみてください（これは完全にはテストしていません）。

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;

Answer 2

スクロール原点

マウスホイールを使用してアクションを実行すると、 _WM_MOUSEWHEEL_メッセージ が送信されます。

マウスホイールを回転させると、フォーカスウィンドウに送信されます。 DefWindowProc関数は、メッセージをウィンドウの親に伝播します。 DefWindowProcは、メッセージを処理するウィンドウが見つかるまでメッセージを親チェーンに伝播するため、メッセージの内部転送はありません。

マウスホイールのオデッセイ ^1）

1. ユーザーはマウスホイールをスクロールします。
2. システムは、_WM_MOUSEWHEEL_メッセージをフォアグラウンドウィンドウのスレッドのメッセージキューに配置します。
3. スレッドのメッセージループは、キューからメッセージをフェッチします（_Application.ProcessMessage_）。このメッセージはタイプTMsgであり、メッセージの対象となるウィンドウハンドルを指定するhwndメンバーがあります。
4. _Application.OnMessage_イベントが発生します。
   1. HandledパラメータTrueを設定すると、メッセージのそれ以上の処理が停止します（次の手順を除く）。
5. _Application.IsPreProcessMessage_メソッドが呼び出されます。
   1. コントロールがマウスをキャプチャしていない場合、フォーカスされたコントロールのPreProcessMessageメソッドが呼び出され、デフォルトでは何も実行されません。 VCLのコントロールはこのメソッドをオーバーライドしていません。
6. _Application.IsHintMsg_メソッドが呼び出されます。
   1. アクティブなヒントウィンドウは、オーバーライドされたIsHintMsgメソッドでメッセージを処理します。メッセージがそれ以上処理されないようにすることはできません。
7. DispatchMessageが呼び出されます。
8. フォーカスされたウィンドウの_TWinControl.WndProc_メソッドがメッセージを受信します。このメッセージはタイプTMessageであり、ウィンドウがありません（これは、このメソッドが呼び出されるインスタンスであるため）。
9. _TWinControl.IsControlMouseMsg_メソッドは、マウスメッセージをウィンドウ化されていない子コントロールの1つに送信する必要があるかどうかを確認するために呼び出されます。
   1. マウスをキャプチャした、または現在のマウス位置にある子コントロールがある場合^2）、次にメッセージが子コントロールのWndProcメソッドに送信されます。手順10を参照してください。（^2） _WM_MOUSEWHEEL_には画面座標でのマウス位置が含まれ、IsControlMouseMsgはクライアント座標（XE2）でのマウス位置を想定しているため、これは発生しません。
10. 継承された_TControl.WndProc_メソッドがメッセージを受信します。
    1. システムがマウスホイールをネイティブにサポートしていない場合（<Win98または<WinNT4.0）、メッセージは_CM_MOUSEWHEEL_メッセージに変換され、_TControl.MouseWheelHandler_に送信されます。手順13を参照してください。
    2. それ以外の場合、メッセージは適切なメッセージハンドラーにディスパッチされます。
11. _TControl.WMMouseWheel_メソッドがメッセージを受信します。
12. _WM_MOUSEWHEEL_windowmessage（システムおよび多くの場合VCLにも）は_CM_MOUSEWHEEL_controlmシステムのキーデータの代わりに便利なVCLの ShiftState 情報を提供するメッセージ（VCLにのみ意味があります）。
13. コントロールのMouseWheelHandlerメソッドが呼び出されます。
    1. コントロールがTCustomFormの場合、_TCustomForm.MouseWheelHandler_メソッドが呼び出されます。
       1. フォーカスされたコントロールがある場合は、_CM_MOUSEWHEEL_がフォーカスされたコントロールに送信されます。手順14を参照してください。
       2. それ以外の場合は、継承されたメソッドが呼び出されます。手順13.2を参照してください。
    2. それ以外の場合は、_TControl.MouseWheelHandler_メソッドが呼び出されます。
       1. マウスをキャプチャし、親がいないコントロールがある場合^3）の場合、メッセージはそのコントロールに送信されます。コントロールのタイプに応じて、手順8または10を参照してください。 （（^3）CaptureはGetCaptureControlで取得され、_Parent <> nil_（XE2）をチェックするため、これは発生しません。
       2. コントロールがフォーム上にある場合、コントロールのフォームのMouseWheelHandlerが呼び出されます。手順13.1を参照してください。
       3. それ以外の場合、またはコントロールがフォームの場合は、_CM_MOUSEWHEEL_がコントロールに送信されます。手順14を参照してください。
14. _TControl.CMMouseWheel_メソッドがメッセージを受信します。
    1. _TControl.DoMouseWheel_メソッドが呼び出されます。
       1. OnMouseWheelイベントが発生します。
       2. 処理されない場合は、スクロール方向に応じて_TControl.DoMouseWheelDown_または_TControl.DoMouseWheelUp_が呼び出されます。
       3. OnMouseWheelDownまたはOnMouseWheelUpイベントが発生します。
    2. 処理されない場合は、_CM_MOUSEWHEEL_が親コントロールに送信されます。手順14を参照してください（これは、上記の引用でMSDNが提供したアドバイスに反すると思いますが、間違いなく開発者が慎重に決定したものです。おそらくそれはまさにこの連鎖を最初から始めるからです。）

備考、観察および考察

この一連の処理のほぼすべてのステップで、何もしないことでメッセージを無視し、メッセージパラメータを変更して変更し、それに基づいて処理し、_Handled := True_を設定するか_Message.Result_をnon-に設定することでキャンセルできます。ゼロ。

一部のコントロールにフォーカスがある場合にのみ、このメッセージはアプリケーションによって受信されます。ただし、_Screen.ActiveCustomForm.ActiveControl_が強制的にnilに設定されている場合でも、VCLは_TCustomForm.SetWindowFocus_を使用して集中制御を保証します。これは、デフォルトで以前のアクティブな形式になります。 （Windows.SetFocus(0)を使用すると、実際にメッセージは送信されません。）

IsControlMouseMsgのバグのため ^2）、TControlは、マウスをキャプチャした場合にのみ_WM_MOUSEWHEEL_メッセージを受信できます。 これは手動で実現できます _Control.MouseCapture := True_を設定しますが、そのキャプチャを迅速にリリースするように特別な注意を払う必要があります。そうしないと、取得するために不要な余分なクリックが必要になるなど、望ましくない副作用が発生します。何かが行われた。さらに、 マウスキャプチャ は通常、マウスダウンイベントとマウスアップイベントの間でのみ発生しますが、この制限を必ずしも適用する必要はありません。ただし、メッセージがコントロールに到達した場合でも、メッセージはMouseWheelHandlerメソッドに送信され、フォームまたはアクティブなコントロールに返送されます。したがって、ウィンドウ化されていないVCLコントロールは、デフォルトではメッセージに作用することはできません。これは別のバグだと思います。そうでなければ、すべてのホイール処理がTControlに実装されているのはなぜですか？コンポーネントの作成者は、まさにこの目的のために独自のMouseWheelHandlerメソッドを実装している可能性があり、この質問に対する解決策が何であれ、この種の既存のカスタマイズを壊さないように注意する必要があります。

TMemo、TListBox、TDateTimePickerのように、ホイールでスクロールできるネイティブコントロール 、TComboBox、TTreeView、TListViewなどは、システム自体によってスクロールされます。このようなコントロールに_CM_MOUSEWHEEL_を送信しても、デフォルトでは効果がありません。これらのサブクラス化されたコントロールは、サブクラスに関連付けられたAPIウィンドウプロシージャとともに送信された_WM_MOUSEWHEEL_メッセージの結果としてスクロールします。 CallWindowProc 、VCLは_TWinControl.DefaultHandler_。奇妙なことに、このルーチンはCallWindowProcを呼び出す前に_Message.Result_をチェックせず、メッセージが送信されると、スクロールを防ぐことはできません。メッセージは、コントロールが通常スクロールできるかどうか、またはコントロールのタイプに応じて、Resultが設定された状態で返されます。 （たとえば、TMemoは_<> 0_を返し、TEditは_0_を返します。）実際にスクロールしたかどうかは、メッセージの結果に影響しません。

VCLコントロールは、上記のようにTControlおよびTWinControlに実装されているデフォルトの処理に依存しています。それらは、DoMouseWheel、DoMouseWheelDown、またはDoMouseWheelUpのホイールイベントに作用します。私の知る限り、ホイールイベントを処理するためにVCLのコントロールがMouseWheelHandlerをオーバーライドしていません。

さまざまなアプリケーションを見ると、ホイールスクロールの動作が標準であるという適合性はないようです。例：MS Wordはホバーされたページをスクロールし、MS Excelはフォーカスされたワークブックをスクロールし、Windows Eplorerはフォーカスされたペインをスクロールし、Webサイトはそれぞれ非常に異なるスクロール動作を実装し、Evernoteはホバーされたウィンドウをスクロールします...そしてDelphiのown IDE）は、フォーカスされたウィンドウとをスクロールすることですべてを上回ります。ただし、コードエディターにカーソルを合わせる場合を除きます。次に、コードエディターは、スクロール（XE2）時にfocusを盗みます。

幸いなことに、Microsoftは少なくとも Windowsベースのデスクトップアプリケーションのユーザーエクスペリエンスガイドライン ：を提供しています。

• ポインタが現在上にあるコントロール、ペイン、またはウィンドウにマウスホイールを影響させます。そうすることで、意図しない結果を回避できます。
• クリックしたり、入力フォーカスを持たずにマウスホイールを有効にします。ホバーするだけで十分です。
• マウスホイールが最も具体的なスコープを持つオブジェクトに影響を与えるようにします。たとえば、ポインタがスクロール可能なペイン内のスクロール可能なリストボックスコントロール上にある場合スクロール可能なウィンドウ。マウスホイールはリストボックスのコントロールに影響します。
• マウスホイールを使用しているときは入力フォーカスを変更しないでください。

したがって、ホバーされたコントロールのみをスクロールするという質問の要件には十分な根拠がありますが、Delphiの開発者はそれを簡単に実装できませんでした。

結論と解決策

推奨されるソリューションは、ウィンドウをサブクラス化しないか、さまざまなフォームまたはコントロールの複数の実装を使用しないソリューションです。

フォーカスされたコントロールがスクロールしないようにするために、コントロールは_CM_MOUSEWHEEL_メッセージを受信しない場合があります。したがって、どのコントロールのMouseWheelHandlerも呼び出されない場合があります。したがって、_WM_MOUSEWHEEL_をコントロールに送信することはできません。したがって、介入のために残された唯一の場所は_TApplication.OnMessage_です。さらに、メッセージはメッセージからエスケープされない可能性があるため、all処理はそのイベントハンドラーで実行する必要があり、すべてのデフォルトのVCLホイール処理がバイパスされる場合、考えられるすべての条件に注意する必要があります。の。

簡単に始めましょう。現在ホバーされている有効なウィンドウは WindowFromPoint で取得されます。

_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の場合、ホバーされたウィンドウはアプリケーションのプロセスに属していないか、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コントロールの場合、複数のメッセージハンドラーが特定の順序で呼び出していると見なされます。マウスの位置にウィンドウ化されていないコントロール（タイプTControlまたは子孫）が有効になっている場合、そのコントロールは間違いなくフォアグラウンドコントロールであるため、最初に_CM_MOUSEWHEEL_メッセージを受け取る必要があります。メッセージは_WM_MOUSEWHEEL_メッセージから作成され、同等のVCLに変換されます。次に、ネイティブコントロールを処理できるようにするには、_WM_MOUSEWHEEL_メッセージをコントロールのDefaultHandlerメソッドに送信する必要があります。そして最後に、前のハンドラーがメッセージを処理しなかったときに、再び_CM_MOUSEWHEEL_メッセージをコントロールに送信する必要があります。これらの最後の2つのステップは、逆の順序で実行することはできません。スクロールボックスのメモもスクロールできる必要があります。

_  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コントロールである必要はありません。例えば。ドラッグ操作中に、マウスメッセージを受信する一時ウィンドウが作成されます（ _TDragObject.DragHandle_ を参照）。すべてのメッセージ？いいえ、_WM_MOUSEWHEEL_はキャプチャウィンドウに送信されないため、リダイレクトする必要があります。さらに、キャプチャウィンドウがメッセージを処理しない場合は、以前に説明した他のすべての処理を実行する必要があります。これはVCLにはない機能です。ドラッグ操作中のホイールでは、_Form.OnMouseWheel_が実際に呼び出されますが、フォーカスされたコントロールまたはホバーされたコントロールはメッセージを受信しません。これは、たとえば、メモの表示部分を超えた場所にあるメモのコンテンツにテキストをドラッグできないことを意味します。

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

これは本質的に仕事をします、そしてそれは以下に提示されるユニットの基礎でした。これを機能させるには、プロジェクトのuses句の1つにユニット名を追加するだけです。次の追加機能があります。

• メインフォーム、アクティブフォーム、またはアクティブコントロールでホイールアクションをプレビューする可能性。
• MouseWheelHandlerメソッドを呼び出す必要がある制御クラスの登録。
• このTApplicationEventsオブジェクトを他のすべてのオブジェクトの前に置く可能性。
• OnMessageイベントのその他すべてのTApplicationEventsオブジェクトへのディスパッチをキャンセルする可能性。
• 分析またはテストの目的で、後でデフォルトのVCL処理を引き続き許可する可能性。

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 (e.g. 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*_イベントのメッセージルーティングを準備して、起動する適切な機会を取得するだけです。このコードは、サードパーティのコントロールではテストされていません。 VclHandlingAfterHandledまたはVclHandlingAfterUnhandledがTrueに設定されている場合、マウスイベントが2回発生する可能性があります。この投稿で私はいくつかの主張をし、VCLには3つのバグがあると考えましたが、それはすべてドキュメントの調査とテストに基づいています。このユニットをテストして、調査結果とバグについてコメントしてください。このかなり長い回答をお詫びします。私は単にブログを持っていません。

^1）A Key’s Odyssey から取った生意気な名前

^2） 私の Quality Centralバグレポート＃135258 を参照してください

^3） 私の Quality Centralバグレポート＃135305 を参照してください

Answer 3

TApplication.OnMessageイベントをオーバーライドして（またはTApplicationEventsコンポーネントを作成して）、イベントハンドラーでWM_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;

ここでは正常に機能しますが、予期しないことが発生した場合に再発しないように保護を追加することもできます。

Answer 4

この記事が役立つかもしれません： mousewheelを使用してリストボックスにスクロールダウンメッセージを送信しますが、リストボックスにはフォーカスがありません[1] 、C＃で書かれていますが、Delphiへの変換もそうではありません大きな問題。フックを使用して、必要な効果を実現します。

マウスが現在置かれているコンポーネントを見つけるには、FindVCLWindow関数を使用できます。この例は、この記事にあります。 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

Answer 5

これは私が使用しているソリューションです：

1. フォームのユニットの実装セクションのuses句にamMouseWheelを追加しますafterforms unit：

   unit MyUnit;
   
   interface
   
   uses
     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
     // Fix and util for mouse wheel
     amMouseWheel;
   ...
   

2. 次のコードをamMouseWheel.pasに保存します。

   unit amMouseWheel;
   
   // -----------------------------------------------------------------------------
   // The original author is Anders Melander, [email protected], 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 (e.g. 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.
   

Answer 6

DevExpressコントロールで使用する場合のみ

XE3で動作します。他のバージョンではテストされていません。

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

Answer 7

私は同じ問題を抱えていて、少しハックして解決しましたが、うまくいきます。

メッセージをいじりたくなかったので、必要な制御を行うために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;

ご覧のとおり、直接の子だけでなく、フォーム上のすべてのコントロールを検索し、親から子へと検索することがわかります。子で再帰検索を行う方が良いですが（ただしコードは多くなります）、上記のコードは問題なく機能します。

1つのコントロールのみがmousewheelイベントに応答するようにするには、実装時に常にHandled：= trueを設定する必要があります。たとえば、パネル内にリストボックスがある場合、パネルは最初にDoMouseWheelを実行し、イベントを処理しなかった場合は、listbox.DoMouseWheelが実行されます。マウスカーソルの下のコントロールがDoMouseWheelを処理しなかった場合、フォーカスされたコントロールは処理しますが、かなり適切な動作のようです。