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 .