41

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

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

4

8 に答える 8

26

スクロールの起源

マウス ホイールを操作すると、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. ウィンドウ メッセージ (システムにとっても、多くの場合 VCL にとってもWM_MOUSEWHEEL 意味があります)は、システムのキー データの代わりに便利な VCL の情報を提供する制御メッセージ (VCL にのみ意味がありCM_MOUSEWHEEL ます) に変換されます。ShiftState
  13. コントロールのMouseWheelHandlerメソッドが呼び出されます。
    1. コントロールが の場合TCustomForm、TCustomForm.MouseWheelHandlerメソッドが呼び出されます。
      1. フォーカスされたコントロールがある場合は、フォーカスされたコントロールにCM_MOUSEWHEEL送信されます。手順 14 を参照してください。
      2. それ以外の場合は、継承されたメソッドが呼び出されます。手順 13.2 を参照してください。
    2. それ以外の場合、TControl.MouseWheelHandlerメソッドが呼び出されます。
      1. マウスをキャプチャし、親を持たないコントロールがある場合3)、メッセージはそのコントロールに送信されます。コントロールのタイプに応じて、手順 8 または 10 を参照してください。( 3) (XE2)をチェックする で取得されるため、これは決して起こりません。)CaptureGetCaptureControlParent <> nil
      2. コントロールがフォーム上にある場合、コントロールのフォームMouseWheelHandlerが呼び出されます。ステップ 13.1 を参照してください。
      3. それ以外の場合、またはコントロールがフォームの場合は、コントロールCM_MOUSEWHEELに送信されます。手順 14 を参照してください。
  14. TControl.CMMouseWheelメソッドはメッセージを受け取ります 。
    1. TControl.DoMouseWheelメソッドが呼び出されます 。
      1. OnMouseWheelイベントが発生します。
      2. 処理されない場合は、スクロール方向に応じてTControl.DoMouseWheelDownorが呼び出されます。TControl.DoMouseWheelUp
      3. OnMouseWheelDownまたはOnMouseWheelUpイベントが発生します。
    2. 処理されない場合はCM_MOUSEWHEEL、親コントロールに送信されます。ステップ 14 を参照してください。非常に連鎖しています。）

備考、所見、考慮事項

Handled := Trueこの一連の処理のほぼすべてのステップで、メッセージは何もしないことによって無視され、メッセージ パラメータを変更することによって変更され、それに基づいて処理され、0 以外に設定または設定することによって取り消されMessage.Resultます。

一部のコントロールにフォーカスがある場合にのみ、このメッセージがアプリケーションによって受信されます。ただし、Screen.ActiveCustomForm.ActiveControlが強制的に に設定されている場合でもnil、VCL は でフォーカスされたコントロールを保証しTCustomForm.SetWindowFocusます。これは、以前にアクティブだったフォームにデフォルト設定されます。(Windows.SetFocus(0)実際、メッセージは決して送信されません。)

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

TMemo、TListBox、TDateTimePicker、TComboBox、TTreeView、などのホイールでスクロールできるネイティブ コントロールTListViewは、システム自体によってスクロールされます。このようなコントロールへの送信CM_MOUSEWHEELは、デフォルトでは効果がありません。これらのサブクラス化されたコントロールはWM_MOUSEWHEEL、サブクラスに関連付けられた API ウィンドウ プロシージャ with に送信されたメッセージの結果としてスクロールします。CallWindowProcこれは VCL で処理されTWinControl.DefaultHandlerます。奇妙なことに、このルーチンはMessage.Resultを呼び出す前にチェックせずCallWindowProc、メッセージが送信されるとスクロールを防止できません。メッセージはResult、コントロールが通常スクロールできるかどうか、またはコントロールのタイプに応じて、セットとともに返されます。(たとえば、 aTMemoが返さ<> 0れ、TEditが返されます0.) 実際にスクロールしたかどうかは、メッセージの結果には影響しません。

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

さまざまなアプリケーションを見てみると、どのホイール スクロール動作が標準であるかについては一致していないようです。例: MS Word はホバーされたページをスクロールし、MS Excel はフォーカスされたワークブックをスクロールし、Windows Eplorer はフォーカスされたペインをスクロールし、Web サイトはそれぞれ非常に異なる方法でスクロール動作を実装し、Evernote はホバーされたウィンドウをスクロールします。独自の IDE は、フォーカスされたウィンドウとホバーされたウィンドウをスクロールすることですべてを上回ります。

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

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

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

結論と解決策

推奨される解決策は、ウィンドウをサブクラス化しない方法、またはさまざまなフォームまたはコントロールの複数の実装を使用しない方法です。

フォーカスされたコントロールがスクロールしないようにするために、コントロールはCM_MOUSEWHEELメッセージを受信しない場合があります。したがって、MouseWheelHandlerどのコントロールも呼び出されない可能性があります。したがって、WM_MOUSEWHEELどのコントロールにも送信されない場合があります。したがって、介入できる唯一の場所は ですTApplication.OnMessage。さらに、メッセージはそこから逃れることができないため、すべての処理はそのイベント ハンドラーで行われ、すべてのデフォルトの 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;

FindControlVCL コントロールへの参照を取得します。結果が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.pa

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.

免責事項:

このコードは意図的に何もスクロールせずOnMouseWheel*、VCL のイベントが発生する適切な機会を得るためにメッセージ ルーティングを準備するだけです。このコードは、サードパーティ コントロールではテストされていません。VclHandlingAfterHandledまたはVclHandlingAfterUnhandledが設定されている場合True、マウス イベントが 2 回発生する可能性があります。この投稿で私はいくつかの主張を行い、VCL には 3 つのバグがあると考えましたが、それはすべてドキュメントの調査とテストに基づいています。このユニットをテストして、調査結果やバグについてコメントしてください。このかなり長い回答をお詫び申し上げます。私は単にブログを持っていません。

1) A Key's Odysseyから引用した生意気なネーミング

2) Quality Central のバグ レポート #135258を参照してください。

3) Quality Central のバグ レポート #135305を参照してください。

于 2015-12-20T22:41:42.303 に答える
24

Try overriding your form's MouseWheelHandler method like this (I have not tested this thoroughly):

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;
于 2010-02-12T12:07:54.497 に答える
7

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;

ここでは問題なく動作しますが、予期しないことが起こった場合に再帰しないように保護を追加することをお勧めします。

于 2010-02-12T12:59:28.080 に答える
2

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

  1. ユニットの後に、フォームのamMouseWheelユニットの実装セクションの uses 句に追加します。forms

    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, anders@melander.dk, 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.
于 2014-02-24T09:32:57.020 に答える
2

この記事は役に立つかもしれません: send a scroll down message to listbox using mousewheel, but listbox does not have focus [1]、C# で書かれていますが、Delphi への変換はそれほど大きな問題にはなりません。フックを使用して、必要な効果を実現します。

マウスが現在どのコンポーネントの上にあるかを調べるには、FindVCLWindow 関数を使用できます。この例は、次の記事に記載されています: Get the Control Under the Mouse in a Delphi application [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

于 2010-02-12T11:14:25.410 に答える
0

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 コントロールを使用しない場合は、Perform -> SendMessage

SendMessage(LControl.Handle, AMsg.message, AMsg.WParam, AMsg.lParam);
于 2016-11-05T06:06:25.330 に答える
-2

各スクロール可能なコントロールの OnMouseEnter イベントで、SetFocus へのそれぞれの呼び出しを追加します。

したがって、ListBox1 の場合:

procedure TForm1.ListBox1MouseEnter(Sender: TObject);  
begin  
    ListBox1.SetFocus;  
end;

これで目的の効果が得られますか?

于 2010-02-12T16:18:09.327 に答える