delphi - loco - rueda del mouse no funciona windows 7

¿Cómo agregar la compatibilidad de la rueda del mouse a un componente que desciende de TGraphicControl?

Question

Creé un componente delphi que desciende de TGraphicControl. ¿Es posible agregar soporte para ruedas de mouse?

--- Editar ---

He expuesto los eventos de MouseWheel como se muestra a continuación, pero no se llaman.

TMyComponent = class(TGraphicControl)
published
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
end;

--- Editar ---

Como se sugiere a continuación, intenté atrapar los mensajes WM_MOUSEWHEEL y CM_MOUSEWHEEL, pero parece que no funciona. Sin embargo, he logrado atrapar el mensaje CM_MOUSEENTER. No entiendo por qué puedo atrapar un tipo de mensaje, pero no el otro.

Answer 1

Atrapa el mensaje WM_MOUSEWHEEL.

Answer 2

Solo los descendientes de TWinControl pueden recibir mensajes de rueda del mouse. TGraphicControl no es un control basado en la ventana y, por lo tanto, no puede. Podría funcionar si el VCL enruta los mensajes al TGraphicControl, pero aparentemente no funciona. Podrías descender desde TCustomControl y luego funcionaría.

Answer 3

TGraphicControl desciende de TControl , que ya tiene compatibilidad con la rueda del mouse. Consulte el mensaje wm_MouseWheel , los DoMouseWheel , DoMouseWheelDown , DoMouseWheelUp y MouseWheelHandler , y la propiedad WheelAccumulator .

Answer 4

Tengo el mismo problema. Todavía no hay suerte para encontrar una solución, pero tal vez esto sea útil:

Sospecho que el otro componente llama al método Win API SetCapture, que de acuerdo con la API ayuda:

"La función SetCapture establece la captura del mouse en la ventana especificada que pertenece al hilo actual. Una vez que una ventana ha capturado el mouse, toda la entrada del mouse se dirige a esa ventana, independientemente de si el cursor está dentro de los límites de esa ventana. ventana a la vez puede capturar el mouse ".

Como nuevo usuario, no puedo publicar un enlace al hilo completo.

EDITADO

Si crea su componente como un descendiente de TCustomControl, puede resolver su problema como se describe a continuación:

1. Use el evento OnMouseEnter para detectar cuándo el mouse ingresa su componente.
2. En OnMouseEnter llama al método SetFocus para enfocar tu componente. Ahora su componente puede recibir el mensaje WM_MOUSEWHEEL

Answer 5

Debido a varias construcciones de VCL (ya sean elecciones de implementación deliberadas o posiblemente bugs ¹⁾ , dejo en el medio) solo el control enfocado y todos sus padres reciben mensajes de la rueda del mouse, así como el control que tiene el mouse capturado tiene un padre enfocado

En el nivel TControl , la última condición se puede aplicar. Un control recibe un mensaje CM_MOUSEENTER del VCL cuando el mouse ingresa en el espacio del cliente del control. Para obligarlo a recibir mensajes de la rueda del mouse, centre su elemento primario y capture el mouse en ese controlador de mensajes:

procedure TWheelControl.CMMouseEnter(var Message: TMessage);
begin
FPrevFocusWindow := SetFocus(Parent.Handle);
MouseCapture := True;
inherited;
end;

Pero estas configuraciones deben deshacerse cuando el mouse sale del control. Como el control ahora está capturando el mouse, CM_MOUSELEAVE no lo recibe, por lo que debe verificarlo manualmente, por ejemplo, en el manejador de mensajes WM_MOUSEMOVE :

procedure TWheelControl.WMMouseMove(var Message: TWMMouseMove);
begin
if MouseCapture and
not PtInRect(ClientRect, SmallPointToPoint(Message.Pos)) then
begin
MouseCapture := False;
SetFocus(FPrevFocusWindow);
end;
inherited;
end;

Ahora, asumiría que los mensajes de rueda recibidos por el control dispararán posteriormente los OnMouseWheel , OnMouseWheelDown y OnMouseWheelUp . Pero noooo, se necesita una intervención más. El mensaje ingresa el control en MouseWheelHandler que pasa el mensaje al formulario o al control activo. Para CM_MOUSEWHEEL estos eventos, se debe enviar un mensaje de control CM_MOUSEWHEEL :

procedure TWheelControl.MouseWheelHandler(var Message: TMessage);
begin
Message.Result := Perform(CM_MOUSEWHEEL, Message.WParam, Message.LParam);
if Message.Result = 0 then
inherited MouseWheelHandler(Message);
end;

Lo que resulta en este código final:

unit WheelControl;
interface
uses
System.Classes, Winapi.Windows, Winapi.Messages, Vcl.Controls;
type
TWheelControl = class(TGraphicControl)
private
FPrevFocusWindow: HWND;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
public
procedure MouseWheelHandler(var Message: TMessage); override;
published
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
end;
implementation
{ TWheelControl }
procedure TWheelControl.CMMouseEnter(var Message: TMessage);
begin
FPrevFocusWindow := SetFocus(Parent.Handle);
MouseCapture := True;
inherited;
end;
procedure TWheelControl.MouseWheelHandler(var Message: TMessage);
begin
Message.Result := Perform(CM_MOUSEWHEEL, Message.WParam, Message.LParam);
if Message.Result = 0 then
inherited MouseWheelHandler(Message);
end;
procedure TWheelControl.WMMouseMove(var Message: TWMMouseMove);
begin
if MouseCapture and
not PtInRect(ClientRect, SmallPointToPoint(Message.Pos)) then
begin
MouseCapture := False;
SetFocus(FPrevFocusWindow);
end;
inherited;
end;
end.

Como puede ver, esto cambia el control centrado, lo cual va en contra de las pautas de experiencia del usuario para las aplicaciones de escritorio basadas en Windows y puede dar como resultado distracciones visuales cuando el control enfocado tiene un estado explícito enfocado.

Como alternativa, puede omitir todo el manejo predeterminado de la rueda del mouse de VCL anulando Application.OnMessage y solucionándolo allí. Esto se puede hacer de la siguiente manera:

unit WheelControl2;
interface
uses
System.Classes, Winapi.Windows, Winapi.Messages, Vcl.Controls, Vcl.AppEvnts,
Vcl.Forms;
type
TWheelControl = class(TGraphicControl)
published
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
end;
implementation
type
TWheelInterceptor = class(TCustomApplicationEvents)
private
procedure ApplicationMessage(var Msg: tagMSG; var Handled: Boolean);
public
constructor Create(AOwner: TComponent); override;
end;
procedure TWheelInterceptor.ApplicationMessage(var Msg: tagMSG;
var Handled: Boolean);
var
Window: HWND;
WinControl: TWinControl;
Control: TControl;
Message: TMessage;
begin
if Msg.message = WM_MOUSEWHEEL then
begin
Window := WindowFromPoint(Msg.pt);
if Window <> 0 then
begin
WinControl := FindControl(Window);
if WinControl <> nil then
begin
Control := WinControl.ControlAtPos(WinControl.ScreenToClient(Msg.pt),
False);
if Control <> nil then
begin
Message.WParam := Msg.wParam;
Message.LParam := Msg.lParam;
TCMMouseWheel(Message).ShiftState :=
KeysToShiftState(TWMMouseWheel(Message).Keys);
Message.Result := Control.Perform(CM_MOUSEWHEEL, Message.WParam,
Message.LParam);
Handled := Message.Result <> 0;
end;
end;
end;
end;
end;
constructor TWheelInterceptor.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
OnMessage := ApplicationMessage;
end;
initialization
TWheelInterceptor.Create(Application);
end.

Tenga cuidado de configurar el parámetro MouseWheel* evento MouseWheel* en True , de lo contrario, el control enfocado se desplazará también.

Consulte también ¿Cómo dirigir la entrada de la rueda del mouse para controlar debajo del cursor en lugar de enfocar? para obtener más información sobre el manejo de la rueda del mouse y una solución más general.

¹⁾ Consulte el informe de errores de Quality Central # 135258 y el informe de errores de Quality Central # 135305 .