delphi - teclado - ¿Cómo dirigir la entrada de la rueda del mouse para controlar debajo del cursor en lugar de enfocar?

usar teclado como mouse windows 10 (8)

Desplazamiento de orígenes

Una acción con la rueda del mouse da como resultado el envío de un mensaje WM_MOUSEWHEEL :

Enviado a la 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 reenvío interno del mensaje, ya que DefWindowProc lo propaga por la cadena padre hasta que encuentra una ventana que lo procesa.

La odisea de ^una rueda de ratón ¹⁾

El usuario desplaza la rueda del mouse.
El sistema coloca un mensaje WM_MOUSEWHEEL en la cola de mensajes del subproceso de la ventana del primer plano.
El bucle de mensaje del hilo recupera el mensaje de la cola ( Application.ProcessMessage ). Este mensaje es del tipo TMsg que tiene un miembro de hwnd designa el identificador de ventana para el que se hwnd el mensaje.
El evento Application.OnMessage se activa.
1. Establecer el parámetro Handled True detiene el procesamiento posterior del mensaje (excepto el siguiente a los pasos).
Se llama al método Application.IsPreProcessMessage .
1. Si ningún control ha capturado el mouse, se llama al método PreProcessMessage del control enfocado, que no hace nada por defecto. Ningún control en el VCL ha anulado este método.
Se llama al método Application.IsHintMsg .
1. La ventana de sugerencia activa maneja el mensaje en un método IsHintMsg modificado. Evitar que el mensaje sea procesado posteriormente no es posible.
Se llama a DispatchMessage .
El método TWinControl.WndProc 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 TMessage este método).
Se TWinControl.IsControlMouseMsg método TWinControl.IsControlMouseMsg para comprobar si el mensaje del mouse se debe dirigir a uno de sus controles secundarios que no están en ventana.
1. Si hay un control secundario que capturó el mouse o está en la posición actual del mouse ²⁾ , el mensaje se envía al método WndProc del control WndProc , consulte el paso 10. ( ²⁾ Esto nunca sucederá, porque WM_MOUSEWHEEL contiene su mouse posición en coordenadas de pantalla e IsControlMouseMsg asume la posición del mouse en las coordenadas del cliente (XE2).)
El método heredado TControl.WndProc 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 mensaje CM_MOUSEWHEEL y se envía a TControl.MouseWheelHandler , consulte el paso 13.
2. De lo contrario, el mensaje se envía al controlador de mensajes apropiado.
El método TControl.WMMouseWheel recibe el mensaje.
El WM_MOUSEWHEEL windam essage (significativo para el sistema y, a menudo también para el VCL) se convierte en un CM_MOUSEWHEEL c CM_MOUSEWHEEL m essage (significativo solo para el VCL) que proporciona la conveniente información del ShiftState del VCL en lugar de los datos de las claves del sistema.
Se llama al método MouseWheelHandler del control.
1. Si el control es TCustomForm , se TCustomForm.MouseWheelHandler método TCustomForm.MouseWheelHandler .
  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, vea el paso 13.2.
2. De lo TControl.MouseWheelHandler , se llama al método TControl.MouseWheelHandler .
  1. Si hay un control que ha capturado el mouse y no tiene ninguno principal ³⁾ , el mensaje se envía a ese control, consulte los pasos 8 o 10, según el tipo de control. ( ³⁾ Esto nunca sucederá, porque Capture se GetCaptureControl con GetCaptureControl , que busca Parent <> nil (XE2)).
  2. Si el control está en un formulario, se llama MouseWheelHandler del formulario del control, 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.
El método TControl.CMMouseWheel recibe el mensaje.
1. Se TControl.DoMouseWheel método TControl.DoMouseWheel .
  1. El evento OnMouseWheel se dispara.
  2. Si no se maneja, se TControl.DoMouseWheelDown o TControl.DoMouseWheelUp , dependiendo de la dirección de desplazamiento.
  3. Se OnMouseWheelDown el evento OnMouseWheelDown o OnMouseWheelUp .
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 que sin duda es una decisión considerada por los desarrolladores. Posiblemente porque eso comenzaría esta misma cadena al final.)

Observaciones, observaciones y consideraciones

En casi cada paso de esta cadena de procesamiento, el mensaje puede ignorarse sin hacer nada, alterarse al cambiar los parámetros del mensaje, manejarse actuando sobre él, y cancelarse configurando Handled := True o estableciendo Message.Result como distinto de cero.

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

Debido a la IsControlMouseMsg en IsControlMouseMsg ²⁾ , un TControl solo puede recibir el mensaje WM_MOUSEWHEEL si capturó el mouse. Esto se puede lograr manualmente estableciendo 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, la captura del mouse generalmente solo tiene lugar entre un mouse hacia abajo y un evento de mouse arriba, pero esta restricción no necesariamente tiene que aplicarse. Pero incluso cuando el mensaje llega al control, se envía a su método MouseWheelHandler , que simplemente lo envía de nuevo al formulario o al control activo. Por lo tanto, los controles VCL que no tienen ventana no pueden actuar en el mensaje de forma predeterminada. Creo que este es otro error, de lo contrario, ¿por qué se han implementado todas las ruedas en TControl ? Los escritores de componentes pueden haber implementado su propio método MouseWheelHandler para este propósito, y cualquiera que sea la solución a esta pregunta, se debe tener cuidado de no romper este tipo de personalización existente.

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

Los controles VCL se basan en el manejo predeterminado tal como se implementó en TControl y TWinControl , como se TWinControl anteriormente. Actúan en eventos de rueda en DoMouseWheel , DoMouseWheelDown o DoMouseWheelUp . Hasta donde yo sé, ningún control en el VCL ha reemplazado a MouseWheelHandler para manejar los eventos de rueda.

Al observar diferentes aplicaciones, parece no haber conformidad con el comportamiento de desplazamiento de la rueda como estándar. Por ejemplo: MS Word desplaza la página que está suspendida, MS Excel desplaza el libro que está enfocado, Windows Eplorer desplaza el panel centrado, los sitios web implementan el comportamiento de desplazamiento de forma muy diferente, Evernote desplaza la ventana que se encuentra, etc ... Y Delphi el propio IDE encabeza todo al desplazarse por la ventana enfocada , así como por la ventana situada, excepto cuando se pasa el editor de código, entonces el editor de código roba el foco cuando se desplaza (XE2).

Afortunadamente, Microsoft ofrece al menos las 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 los que se encuentra el puntero. Al hacerlo, evita los resultados no deseados.
Haga que la rueda del mouse surta efecto sin hacer clic o tener un foco de entrada. Pasar es suficiente.
Haga que la rueda del mouse afecte al objeto con el alcance más específico. Por ejemplo, si el puntero se encuentra sobre un control de cuadro de lista desplazable en un panel desplazable dentro de una ventana desplazable, la rueda del mouse afecta al control de cuadro de lista.
No cambie el enfoque de entrada cuando use la rueda del mouse.

Por lo tanto, el requisito de la pregunta para desplazarse solo por el control suspendido tiene motivos suficientes, 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, el control puede no recibir el mensaje CM_MOUSEWHEEL . 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 lo tanto, el único lugar que queda para la intervención es TApplication.OnMessage . Además, el mensaje puede no escapar de él, por lo que todo el manejo debe tener lugar en ese controlador de eventos y cuando se omite todo el manejo predeterminado de la rueda VCL, se deben tener en cuenta todas las condiciones posibles.

Comencemos simple. La ventana habilitada que actualmente está WindowFromPoint 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 anularizada no pertenece al proceso de la aplicación, o es una ventana desconocida para el VCL (por ejemplo, un TDateTimePicker desplegado). 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 de VCL, se deben considerar múltiples manejadores de mensajes, en un orden específico. Cuando hay un control no windowed habilitado (de tipo TControl o descendiente) en la posición del mouse, primero debe obtener un mensaje CM_MOUSEWHEEL porque ese control es definitivamente el control de primer plano. El mensaje se construirá a partir del mensaje WM_MOUSEWHEEL y se traducirá a su equivalente VCL. En segundo lugar, el mensaje WM_MOUSEWHEEL debe enviarse al método DefaultHandler del control para permitir el manejo de controles nativos. Y, por último, una vez más, el mensaje CM_MOUSEWHEEL debe enviarse al control cuando ningún manejador anterior se hizo cargo del mensaje. Estos dos últimos pasos no pueden realizarse en orden inverso porque, por ejemplo, una nota en un cuadro de desplazamiento debe poder desplazarse también.

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 deben enviar todos los mensajes de la rueda. La ventana recuperada por GetCapture está garantizada para ser una ventana del proceso actual, pero no tiene que ser un control de VCL. Por ejemplo, durante una operación de arrastre, se crea una ventana temporal (ver TDragObject.DragHandle ) que recibe los mensajes del mouse. ¿Todos los mensajes? Noooo, WM_MOUSEWHEEL no se envía a la ventana de captura, por lo que debemos redirigirlo. Además, cuando la ventana de captura no maneja el mensaje, deben tener lugar todos los demás procesos cubiertos anteriormente. Esta es una característica que falta en la VCL: al girar durante una operación de arrastre, se llama a Form.OnMouseWheel , pero el control centrado 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 presentada a continuación. Para que funcione, solo agrega el nombre de la unidad a una de las cláusulas de uso de tu proyecto. Tiene las siguientes características adicionales:

La posibilidad de previsualizar una acción de rueda en la forma principal, la forma activa o el control activo.
Registro de las clases de control para las que se debe llamar su método MouseWheelHandler .
La posibilidad de llevar este objeto TApplicationEvents por delante de todos los demás.
La posibilidad de cancelar el envío del evento OnMessage a todos los demás objetos TApplicationEvents .
La posibilidad de seguir permitiendo el manejo predeterminado de VCL luego para 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.

Renuncia:

Este código intencionalmente no desplaza nada, solo prepara el enrutamiento del mensaje para los eventos OnMouseWheel* VCL para obtener la oportunidad adecuada de ser despedido. Este código no está probado en controles de terceros. Cuando VclHandlingAfterHandled o VclHandlingAfterUnhandled se establece en True , los eventos del mouse se pueden disparar dos veces. En este post hice algunas afirmaciones y consideré que había tres errores en el VCL, sin embargo, todo se basa en el estudio de la documentación y las pruebas. Por favor, prueba esta unidad y comenta los hallazgos y errores. Me disculpo por esta respuesta bastante larga; Simplemente no tengo un blog.

¹⁾ Nombrar descarado tomado de A Key''s Odyssey

²⁾ Consulte mi informe de errores de Quality Central # 135258

³⁾ Consulte mi informe de errores de Quality Central # 135305

Uso una cantidad de 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 el control del cursor del mouse.

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

Esta es la solución que he estado usando:

Agregue amMouseWheel a la cláusula uses de la sección de implementación de la unidad de su formulario después de la unidad de forms :
unit MyUnit; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, // Fix and util for mouse wheel amMouseWheel; ...
Guarde el siguiente código en 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.

Puede encontrar este artículo útil: envíe un mensaje de desplazamiento hacia abajo al cuadro de lista usando 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 qué componente está actualmente sobre el mouse, puede usar la función FindVCLWindow, un ejemplo de esto se puede encontrar en este artículo: Obtenga el control debajo del mouse en una aplicación 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

Reemplace 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 un poco de protección para evitar recurrencias si ocurre algo inesperado.

Tuve el mismo problema y lo resolví con algún 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. Hack es que DoMouseWheel es un método protegido y, por lo tanto, no se puede acceder desde el archivo de unidad de formulario, es por eso que definí mi clase en la 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 la forma, no solo los niños inmediatos, y resulta que busca de padres a hijos. Sería mejor (pero más código) hacer búsquedas recursivas en niños, pero el código anterior funciona bien.

Para hacer que solo un control responda al evento mousewheel, siempre debe configurar Handled: = true cuando se implementa. Si, por ejemplo, tiene listbox dentro del panel, el panel ejecutará DoMouseWheel primero, y si no manejó el evento, se ejecutará listbox.DoMouseWheel. Si el control bajo el cursor del mouse no maneja DoMouseWheel, el control enfocado lo hará, parece un comportamiento bastante adecuado.

Solo para usar con controles DevExpress

Funciona en XE3. No fue probado 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 DevExpress, entonces realice -> SendMessage

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

In the OnMouseEnter event for each scrollable control add a respective call to SetFocus

So for ListBox1:

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

Does this achieve the desired effect?

Intente anular el método MouseWheelHandler su formulario de esta manera (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;