¿Cómo dirigir la entrada de la rueda del mouse para controlar bajo el cursor en lugar de enfocar?

Utilizo varios controles de desplazamiento: TTreeViews, TListViews, DevExpress cxGrids y cxTreeLists, etc. Cuando se gira la rueda del mouse, el control con foco recibe la entrada sin importar en qué control se encuentre el cursor del mouse.

¿Cómo se dirige la entrada de la rueda del mouse a cualquier control sobre el que se encuentre el cursor del mouse? El IDE de Delphi funciona muy bien en este sentido.

preguntado el 12 de febrero de 10 a las 07:02

8 Respuestas

Intente anular su formulario MouseWheelHandler método como este (no lo he probado a fondo):

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;

Respondido el 08 de junio de 10 a las 09:06

Casi funciona. ControlAtPos () obtiene el hijo inmediato, por lo que si el control está en el panel, devuelve el panel. FindVCLWindow (Mouse.CursorPos) devuelve el control correcto. Solo DevExpress TcxTreeList se desplaza demasiado, parece hacer 3 veces el desplazamiento. - Avenmore

Esta resultó ser la solución que funcionó para mí. La solución al desplazamiento excesivo fue establecer Message.Result: = 1. Tendremos cuidado con las limitaciones de FindVCLWindow. Gracias por la ayuda. - Avenmore

Por alguna razón, este código produce StackOverflow cuando me desplazo por encima de TMyForm - Kromster

Este código puede producir StackOverflow en las circunstancias adecuadas cuando la función MouseWheelHandler es MouseWheelHandler para el Control que se pasa a. Resolví esto agregando una variable "ScrollControl" en mi formulario que se establece antes de llamar a "Perform", y verifiqué junto con ActiveControl para que no se repita infinitamente. También debe establecerse en cero al final. - kbickar

Esto me dio un desbordamiento de pila y tampoco funcionó. La respuesta de Zoe a continuación funcionó, pero no del todo. No se desplazaría un TScrollBox y cuando un TDBGrid tenía enfoque, capturó el enfoque de todos modos. - jerry esquivar

Orígenes de desplazamiento

Una acción con la rueda del mouse da como resultado un WM_MOUSEWHEEL mensaje siendo enviado:

Enviado al ventana de enfoque cuando se gira la rueda del mouse. La función DefWindowProc propaga el mensaje al padre de la ventana. No debería haber un reenvío interno del mensaje, ya que DefWindowProc lo propaga por la cadena principal hasta que encuentra una ventana que lo procesa.

La odisea de una rueda de ratón 1)

  1. El usuario desplaza la rueda del mouse.
  2. El sistema coloca un WM_MOUSEWHEEL mensaje en la cola de mensajes del hilo de la ventana de primer plano.
  3. El bucle de mensajes del hilo recupera el mensaje de la cola (Application.ProcessMessage). Este mensaje es de tipo TMsg que tiene un hwnd miembro que designa el identificador de ventana para el que está indicado el mensaje.
  4. El Application.OnMessage se dispara el evento.
    1. Configurando el Handled parámetro True detiene el procesamiento posterior del mensaje (excepto para los pasos siguientes).
  5. El Application.IsPreProcessMessage método se llama.
    1. Si ningún control ha capturado el mouse, el control enfocado PreProcessMessage se llama al método, que no hace nada de forma predeterminada. Ningún control de la VCL ha anulado este método.
  6. El Application.IsHintMsg método se llama.
    1. La ventana de sugerencia activa maneja el mensaje en una anulación IsHintMsg método. No es posible evitar que el mensaje se procese más.
  7. DispatchMessage se llama.
  8. El TWinControl.WndProc El método de la ventana enfocada recibe el mensaje. Este mensaje es de tipo TMessage que carece de la ventana (porque esa es la instancia a la que se llama este método).
  9. El TWinControl.IsControlMouseMsg se llama al método para comprobar si el mensaje del mouse debe dirigirse a uno de sus controles secundarios sin ventana.
    1. Si hay un control secundario que ha capturado el mouse o está en la posición actual del mouse2), luego el mensaje se envía al control secundario WndProc método, vea el paso 10. (2) Esto se nunca suceder, porque WM_MOUSEWHEEL contiene la posición del mouse en las coordenadas de la pantalla y IsControlMouseMsg asume una posición del mouse en las coordenadas del cliente (XE2).)
  10. El heredado TControl.WndProc método recibe el mensaje.
    1. Cuando el sistema no admite de forma nativa la rueda del mouse (<Win98 o <WinNT4.0), el mensaje se convierte en un CM_MOUSEWHEEL mensaje y se envía a TControl.MouseWheelHandler, vea el paso 13.
    2. De lo contrario, el mensaje se envía al controlador de mensajes adecuado.
  11. El TControl.WMMouseWheel método recibe el mensaje.
  12. El WM_MOUSEWHEEL winterior mmensaje (significativo para el sistema y, a menudo, también para el VCL) se convierte en un CM_MOUSEWHEEL control mmensaje (significativo solo para el VCL) que proporciona los convenientes VCL ShiftState información en lugar de los datos de las claves del sistema.
  13. El control MouseWheelHandler método se llama.
    1. Si el control es un TCustomForm, Entonces el TCustomForm.MouseWheelHandler método se llama.
      1. Si hay un control enfocado en él, entonces CM_MOUSEWHEEL se envía al control enfocado, vea el paso 14.
      2. De lo contrario, se llama al método heredado, consulte el paso 13.2.
    2. De lo contrario, el TControl.MouseWheelHandler método se llama.
      1. Si hay un control que ha capturado el mouse y no tiene padre3), luego el mensaje se envía a ese control, vea el paso 8 o 10, dependiendo del tipo de control. (3) Esto se nunca suceder, porque Capture se consigue con GetCaptureControl, que busca Parent <> nil (XE2).)
      2. Si el control está en un formulario, entonces el formulario del control MouseWheelHandler se llama, consulte el paso 13.1.
      3. De lo contrario, o si el control es el formulario, entonces CM_MOUSEWHEEL se envía al control, consulte el paso 14.
  14. El TControl.CMMouseWheel método recibe el mensaje.
    1. El TControl.DoMouseWheel método se llama.
      1. El OnMouseWheel se dispara el evento.
      2. Si no se maneja, entonces TControl.DoMouseWheelDown or TControl.DoMouseWheelUp se llama, dependiendo de la dirección de desplazamiento.
      3. El OnMouseWheelDown o OnMouseWheelUp se dispara el evento.
    2. Si no se maneja, entonces CM_MOUSEWHEEL se envía al control principal, consulte el paso 14. (Creo que esto va en contra del consejo dado por MSDN en la cita anterior, pero sin duda es una decisión reflexiva tomada por los desarrolladores. Posiblemente porque eso iniciaría esta misma cadena de nuevo. )

Comentarios, observaciones y consideraciones

En casi todos los pasos de esta cadena de procesamiento, el mensaje puede ignorarse sin hacer nada, modificarse cambiando los parámetros del mensaje, manejarse actuando sobre él y cancelarse configurando Handled := True o el ajuste Message.Result a distinto de cero.

Solo cuando algún control tiene el foco, la aplicación recibe este mensaje. Pero incluso cuando Screen.ActiveCustomForm.ActiveControl se establece con fuerza en nil, el VCL asegura un control enfocado con TCustomForm.SetWindowFocus, que por defecto es el formulario previamente activo. (Con Windows.SetFocus(0), de hecho, el mensaje nunca se envía).

Debido al error en IsControlMouseMsg 2), TControl solo puede recibir el WM_MOUSEWHEEL mensaje si ha capturado el mouse. Esto se puede lograr manualmente configurando Control.MouseCapture := True, pero debe tener especial cuidado de liberar esa captura rápidamente, de lo contrario tendrá efectos secundarios no deseados, como la necesidad de un clic adicional innecesario para hacer algo. Además, captura del mouse por lo general, solo tiene lugar entre un evento de mouse hacia abajo y hacia arriba, pero esta restricción no tiene que aplicarse necesariamente. Pero incluso cuando el mensaje llega al control, se envía a su MouseWheelHandler método que simplemente lo envía de vuelta al formulario o al control activo. Por lo tanto, los controles VCL sin ventana nunca pueden actuar sobre el mensaje de forma predeterminada. Creo que este es otro error, de lo contrario, ¿por qué se habrían implementado todos los manejos de las ruedas en TControl? Los escritores de componentes pueden haber implementado sus propios MouseWheelHandler para este mismo propósito, y cualquiera que sea la solución a esta pregunta, hay que tener cuidado de no romper este tipo de personalización existente.

Controles nativos que son capaces de desplazarse con la rueda, como TMemo, TListBox, TDateTimePicker, TComboBox, TTreeView, TListView, etc. son desplazados por el propio sistema. Enviando CM_MOUSEWHEEL a tal control no tiene ningún efecto por defecto. Estos controles de subclases se desplazan como resultado de la WM_MOUSEWHEEL mensaje enviado al procedimiento de ventana API asociado con la subclase con CallWindowProc, que la VCL se ocupa en TWinControl.DefaultHandler. Por extraño que parezca, esta rutina no marca Message.Result antes de llamar CallWindowProc, y una vez enviado el mensaje, no se puede evitar el desplazamiento. El mensaje vuelve con su Result se configura dependiendo de si el control normalmente es capaz de desplazarse o del tipo de control. (Por ejemplo, un TMemo devoluciones <> 0 y TEdit devoluciones 0.) Si realmente se desplazó no influye en el resultado del mensaje.

Controles VCL confiar en el manejo predeterminado como se implementó en TControl y TWinControl, como se muestra arriba. Actúan sobre eventos de rueda en DoMouseWheel, DoMouseWheelDown or DoMouseWheelUp. Hasta donde yo sé, ningún control en el VCL se ha anulado MouseWheelHandler para manejar eventos de rueda.

En cuanto a las diferentes aplicaciones, parece no haber conformidad sobre qué comportamiento de desplazamiento de la rueda es el estándar. Por ejemplo: MS Word desplaza la página que está flotando, MS Excel desplaza el libro de trabajo que está enfocado, Windows Eplorer desplaza el panel enfocado, los sitios web implementan un comportamiento de desplazamiento cada uno de manera muy diferente, Evernote desplaza la ventana que está flotando, etc. propio IDE encabeza todo desplazando la ventana enfocada al igual que la ventana flotante, excepto cuando se mueve el cursor sobre el editor de código, luego el editor de código roba el enfoque cuando se desplaza (XE2).

Afortunadamente, Microsoft ofrece al menos pautas de experiencia del usuario para aplicaciones de escritorio basadas en Windows:

  • Haga que la rueda del mouse afecte el control, el panel o la ventana sobre la que se encuentra el puntero. Si lo hace, evitará resultados no deseados.
  • Haga que la rueda del mouse surta efecto sin hacer clic ni tener el foco de entrada. Flotar es suficiente.
  • Haga que la rueda del mouse afecte al objeto con el alcance más específico. Por ejemplo, si el puntero está sobre un control de cuadro de lista desplazable en un panel desplazable dentro de una ventana desplazable, la rueda del mouse afecta el control del cuadro de lista.
  • No cambie el enfoque de entrada cuando use la rueda del mouse.

Entonces, el requisito de la pregunta de desplazar solo el control flotante tiene suficientes motivos, pero los desarrolladores de Delphi no han facilitado su implementación.

Conclusión y solución

La solución preferida es una sin subclases de ventanas o implementaciones múltiples para diferentes formas o controles.

Para evitar que el control enfocado se desplace, es posible que el control no reciba la CM_MOUSEWHEEL mensaje. Por lo tanto, MouseWheelHandler de cualquier control no se puede llamar. Por lo tanto, WM_MOUSEWHEEL no se puede enviar a ningún control. Por tanto, el único lugar que queda para la intervención es TApplication.OnMessage. Además, es posible que el mensaje no se escape de él, por lo que todos las El manejo debe tener lugar en ese controlador de eventos y cuando se omite todo el manejo de ruedas VCL predeterminado, se deben atender todas las condiciones posibles.

Empecemos de forma sencilla. La ventana habilitada que actualmente está flotando se obtiene con 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;

Con FindControl obtenemos una referencia al control VCL. Si el resultado es nil, entonces la ventana flotante no pertenece al proceso de la aplicación, o es una ventana desconocida para la VCL (por ejemplo, una ventana desplegable TDateTimePicker). En ese caso, el mensaje debe reenviarse a la API y su resultado no nos interesa.

  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;

Cuando la ventana es un control VCL, se considerará que varios manejadores de mensajes llaman, en un orden específico. Cuando hay un control sin ventana habilitado (de tipo TControl o descendiente) en la posición del mouse, primero debe obtener un CM_MOUSEWHEEL mensaje porque ese control es definitivamente el control de primer plano. El mensaje debe construirse a partir del WM_MOUSEWHEEL mensaje y traducido a su equivalente VCL. En segundo lugar, el WM_MOUSEWHEEL El mensaje debe enviarse al control DefaultHandler método para permitir el manejo de controles nativos. Y por fin, de nuevo el CM_MOUSEWHEEL El mensaje debe enviarse al control cuando ningún controlador anterior se haya ocupado del mensaje. Estos dos últimos pasos no pueden realizarse en orden inverso porque, por ejemplo, una nota en un cuadro de desplazamiento también debe poder desplazarse.

  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;

Cuando una ventana ha capturado el mouse, se le deben enviar todos los mensajes de rueda. La ventana recuperada por GetCapture Se asegura que sea una ventana del proceso actual, pero no tiene que ser un control VCL. Por ejemplo, durante una operación de arrastre, se crea una ventana temporal (ver TDragObject.DragHandle) que recibe mensajes del mouse. ¿Todos los mensajes? Noooo WM_MOUSEWHEEL no se envía a la ventana de captura, por lo que tenemos que redirigirlo. Además, cuando la ventana de captura no maneja el mensaje, todos los demás procesos cubiertos anteriormente deben tener lugar. Esta es una característica que falta en el VCL: al girar durante una operación de arrastre, Form.OnMouseWheel de hecho se llama, pero el control enfocado o suspendido no recibe el mensaje. Esto significa, por ejemplo, que un texto no se puede arrastrar al contenido de una nota en una ubicación que esté más allá de la parte visible de la nota.

    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;

Esto esencialmente hace el trabajo, y fue la base para la unidad que se presenta a continuación. Para que funcione, simplemente agregue el nombre de la unidad a una de las cláusulas de usos en su proyecto. Tiene las siguientes características adicionales:

  • La posibilidad de preestreno una acción de rueda en la forma principal, la forma activa o el control activo.
  • Registro de clases de control para las que su MouseWheelHandler se debe llamar al método.
  • La posibilidad de traer esto TApplicationEvents objeto frente a todos los demás.
  • La posibilidad de cancelar el envío del OnMessage evento a todos los demás TApplicationEvents objetos.
  • La posibilidad de seguir permitiendo el manejo de VCL predeterminado posteriormente con fines analíticos o de prueba.

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.

Cláusula de exención de responsabilidades:

Este código intencionalmente no desplazarse por cualquier cosa, solo prepara el enrutamiento de mensajes para VCL OnMouseWheel* eventos para tener la oportunidad adecuada de ser despedido. Este código no se prueba en controles de terceros. Cuando VclHandlingAfterHandled or VclHandlingAfterUnhandled está ajustado True, los eventos del mouse se pueden disparar dos veces. En esta publicación hice algunas afirmaciones y consideré que había tres errores en la VCL, sin embargo, todo se basa en el estudio de la documentación y las pruebas. Pruebe esta unidad y comente los hallazgos y errores. Pido disculpas por esta respuesta bastante larga; Simplemente no tengo un blog.

1) Nombrar descarado tomado de La odisea de una llave

2) Lee mi Informe de error de Quality Central # 135258

3) Lee mi Informe de error de Quality Central # 135305

contestado el 23 de mayo de 17 a las 13:05

"Enviado a la ventana de enfoque cuando ..." vs "... el bucle de mensajes del hilo recupera el mensaje de la cola ..." Me pregunto por qué la documentación insiste en que el mensaje es expedido (también aquí) aunque evidentemente este no es el caso. - Sertac Akyuz

"El mensaje vuelve con su conjunto de resultados ..."Conjuntos RTL todos y cada uno el resultado del mensaje enviado a 0, en classes.StdWndProc, antes de llamar al procedimiento de la ventana de destino. - Sertac Akyuz

@Ser El documentación dóes explican dos métodos de enrutamiento de mensajes diferentes, pero creo que prefieren usar un solo término como sinónimo en aras de la simplicidad, porque para dar un resumen cada vez que la documentación menciona enviando no beneficiaría la legibilidad. Pero, de hecho, los programadores de escritorio de Windows deberían ser conscientes de la gran diferencia entre, por ejemplo, PostMessage y SendMessage. - NGLN

@Ser Allí, estoy hablando del tipo de resultado del mensaje durante la llamada de TWinControl.DefaultHandler, que es la última rutina que pasa el mensaje, mucho más allá de la hora en que se creó con Classes.StdWndProc. - NGLN

¿Es esta la respuesta más larga en StackOverflow? No me quejo. Es bueno que termine con una respuesta concreta. - Gravedad

Anule el evento TApplication.OnMessage (o cree un componente TApplicationEvents) y redirija el mensaje WM_MOUSEWHEEL en el controlador de eventos:

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;

Funciona bien aquí, aunque es posible que desee agregar algo de protección para evitar que se repita si sucede algo inesperado.

Respondido el 15 de enero de 15 a las 19:01

Creo que esta es la mejor respuesta. El problema es que un control DevExpress enfocado aún intercepta este mensaje. Si llamo a C.Perform () en lugar de SendMessage (), los controles de DevExpress funcionan, pero los controles comunes no. Tengo que investigar un poco en la fuente de DevExpress para deshabilitar este gancho. - Avenmore

Terminé abandonando esta solución ya que parece que el TControl enfocado (nada que ver con DevExpress) siempre intercepta el mensaje. - Avenmore

Esto es lo más cercano que puedo encontrar, pero aún no funciona. Como se mencionó, un control enfocado siempre termina desplazándose de todos modos. Incluso si, por ejemplo, un TDBGrid tiene el foco, pero el mouse se desplaza hacia otra cosa, aún desplaza el TDBGrid. - jerry esquivar

He notado que esto funciona en XE8, pero no funciona en 10 Seattle, al menos en mi env. - Benok

Este artículo puede resultarle útil: enviar un mensaje de desplazamiento hacia abajo al cuadro de lista con la rueda del mouse, pero el cuadro de lista no tiene el foco [1], está escrito en C #, pero la conversión a Delphi no debería ser un problema demasiado grande. Utiliza ganchos para lograr el efecto deseado.

Para saber sobre qué componente se encuentra actualmente el mouse, puede usar la función FindVCLWindow, un ejemplo de esto se puede encontrar en este artículo: Obtenga el control con el mouse en una aplicación Delphi [2].

[ XNMUX ] http://social.msdn.microsoft.com/forums/en-US/winforms/thread/ec1fbfa2-137e-49f6-b444-b634e4f44f21/
[ XNMUX ] http://delphi.about.com/od/delphitips2008/qt/find-vcl-window.htm

Respondido 12 Feb 10, 11:02

Esta es la solución que he estado usando:

  1. Añada amMouseWheel a la cláusula de usos de la sección de implementación de la unidad de su formulario después de el forms unidad:

    unit MyUnit;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
      // Fix and util for mouse wheel
      amMouseWheel;
    ...
    
  2. Guarde el siguiente código en 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.
    

Respondido 24 Feb 14, 09:02

Esto no hizo absolutamente nada por mí. - jerry esquivar

@JerryDodge funciona bien para mí en todos los lugares donde lo he usado y he escuchado de otros que también funciona para ellos. Realmente no puedo comentar por qué no funciona para usted ya que no ha descrito lo que ha hecho. Debe publicar una nueva pregunta con detalles sobre sus requisitos y problemas particulares. - Monstruo de la velocidad

Hablé demasiado pronto y olvidé volver y editar, lo siento. Funciona, pero no del todo. El problema principal es que si otro control tiene actualmente el foco, todavía se desplaza, por ejemplo, un TDBGrid (que se usa ampliamente en nuestra aplicación). Así que termino con dos controles desplazándose al mismo tiempo. De hecho, comencé una recompensa por esta pregunta, porque hacer una nueva pregunta simplemente se marcaría como un duplicado de esta. - jerry esquivar

@JerryDodge ¿Qué versión de Delphi? ¿Estás usando el TForm.MouseWheelHandler solución o la ControlDoMouseWheel() ¿solución? Intente colocar un punto de interrupción en el Perform(CM_MOUSEWHEEL)/DoMouseWheel() llama. ¿El objetivo devuelve el valor correcto (es decir, un valor que indica que manejó el evento)? Si el objetivo devuelve un valor incorrecto, obtendrá el síntoma que está viendo. - Monstruo de la velocidad

Tuve el mismo problema y lo resolví con un pequeño truco, pero funciona.

No quería perder el tiempo con los mensajes y decidí simplemente llamar al método DoMouseWheel para controlar lo que necesito. El truco es que DoMouseWheel es un método protegido y, por lo tanto, no es accesible desde el archivo de unidad de formulario, por eso definí mi clase en unidad de formulario:

TControlHack = class(TControl)
end;  //just to call DoMouseWheel

Luego escribí el controlador de eventos 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;

Como puede ver, busca todos los controles en el formulario, no solo los hijos inmediatos, y resulta que busca de padres a hijos. Sería mejor (pero más código) realizar búsquedas recursivas en niños, pero el código anterior funciona bien.

Para que solo un control responda al evento de la rueda del mouse, siempre debe establecer Handled: = true cuando se implemente. Si, por ejemplo, tiene un cuadro de lista dentro del panel, el panel ejecutará primero DoMouseWheel, y si no manejó el evento, se ejecutará listbox.DoMouseWheel. Si ningún control bajo el cursor del mouse manejó DoMouseWheel, el control enfocado lo hará, parece un comportamiento bastante adecuado.

Respondido el 07 de diciembre de 15 a las 14:12

Gracias, pero esto no ayudó. Los mismos problemas que se describen en mis comentarios sobre las otras respuestas. - jerry esquivar

Al menos supongo que no obtiene un desbordamiento de pila (es simplemente imposible en este código). ¿Scrollbox funciona como debería? - Yuri Afanasenkov

Solo para usar con controles DevExpress

Funciona en XE3. No se probó en otras versiones.

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;

si no usa los controles de DevExpress, entonces Ejecutar -> Enviar mensaje

SendMessage(LControl.Handle, AMsg.message, AMsg.WParam, AMsg.lParam);

respondido 05 nov., 16:10

En el evento OnMouseEnter para cada control desplazable, agregue una llamada respectiva a SetFocus

Entonces para ListBox1:

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

¿Esto logra el efecto deseado?

Respondido 12 Feb 10, 16:02

No, eso sería un mal comportamiento para un programa. - Avenmore

Esto cambiará la experiencia del usuario en el servidor. No todo el mundo ha trabajado con el administrador de ventanas X donde mueves el mouse para enfocar diferentes ventanas .. - Ritsaert Hornstra

Esta sería una experiencia de usuario horrible. El enfoque significa mucho. Solo el usuario debe decidir cuándo establecer el enfoque. - jerry esquivar

No es la respuesta que estás buscando? Examinar otras preguntas etiquetadas or haz tu propia pregunta.