Comment diriger l'entrée de la molette de la souris pour contrôler sous le curseur au lieu de se concentrer?

Question

J'utilise un certain nombre de commandes de défilement: TTreeViews, TListViews, cXGrids et cxTreeLists de DevExpress, etc. Lorsque la molette de la souris est tournée, le contrôle ayant le focus reçoit l'entrée, quel que soit le contrôle utilisé par le curseur de la souris.

Comment dirigez-vous la molette de la souris sur le contrôle du curseur de la souris? L'EDI de Delphi fonctionne très bien à cet égard.

Answer 1

Essayez de remplacer la méthode MouseWheelHandler votre formulaire de cette manière (je n'ai pas testé cela à fond):

 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;
 

Answer 2

Remplacez l'événement TApplication.OnMessage (ou créez un composant TApplicationEvents) et redirigez le message WM_MOUSEWHEEL dans le gestionnaire d'événements:

 procedure TMyForm.AppEventsMessage(var Msg: tagMSG;
  var Handled: Boolean);
var
  Pt: TPoint;
  C: TWinControl;
begin
  if Msg.message = WM_MOUSEWHEEL then begin
    Pt.X := Word(Msg.lParam);
    Pt.Y := HiWord(Msg.lParam);
    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;
 

Cela fonctionne bien ici, bien que vous souhaitiez peut-être ajouter une protection pour l'empêcher de se reproduire si quelque chose d'inattendu se produit.

Answer 3

Vous pouvez trouver cet article utile: envoyer un défilement vers le bas de message de zone de liste à l'aide de la roulette de la souris, mais listbox n'ont pas d'accent [1], il est écrit en C#, mais la conversion de Delphi ne devrait pas être un trop grand problème. Il utilise des crochets pour accomplir l'effet recherché.

Pour savoir quel composant de la souris est actuellement de plus, vous pouvez utiliser le FindVCLWindow fonction, un exemple de ceci peut être trouvé dans cet article: Obtenir le Contrôle de la Souris, dans une application 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

Answer 4

Voici la solution que j'utilise:

1. Ajoutez amMouseWheel à la clause uses de la section d'implémentation de l'unité de votre formulaire après forms unité:

    unit MyUnit;
   
   interface
   
   uses
     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
     // Fix and util for mouse wheel
     amMouseWheel;
   ...
    

2. Enregistrez le code suivant dans 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.
    

Answer 5

Dans l'événement OnMouseEnter pour chaque contrôle déroulant, ajoutez un appel respectif à SetFocus.

Donc pour ListBox1:

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

Est-ce que cela produit l'effet désiré?