Come dirigere l’input della rotellina del mouse per controllare sotto il cursore invece che focalizzato?

Uso un numero di controlli a scorrimento: TTreeViews, TListViews, DevExpress cxGrids e cxTreeLists, ecc. Quando la rotellina del mouse viene ruotata, il controllo con focus riceve l’input indipendentemente dal controllo del puntatore del mouse.

Come si indirizza l’input della rotellina del mouse a qualsiasi controllo del puntatore del mouse? L’IDE Delphi funziona molto bene a questo proposito.

Prova a eseguire l’override del metodo MouseWheelHandler del modulo in questo modo (non l’ho verificato 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; 

Origini di scorrimento

Un’azione con la rotellina del mouse provoca l’ WM_MOUSEWHEEL un messaggio WM_MOUSEWHEEL :

Inviato alla finestra di messa a fuoco quando viene ruotata la rotellina del mouse. La funzione DefWindowProc propaga il messaggio al padre della finestra. Non dovrebbe esserci alcun inoltro interno del messaggio, poiché DefWindowProc lo propaga sulla catena padre fino a quando non trova una finestra che lo elabora.

Odissea di una rotellina del mouse 1)

  1. L’utente fa scorrere la rotellina del mouse.
  2. Il sistema posiziona un messaggio WM_MOUSEWHEEL nella coda dei messaggi del thread della finestra in primo piano.
  3. Il ciclo di messaggi del thread recupera il messaggio dalla coda ( Application.ProcessMessage ). Questo messaggio è di tipo TMsg che ha un membro hwnd designa la maniglia della finestra per il messaggio.
  4. L’evento Application.OnMessage è triggersto.
    1. L’impostazione del parametro Handled True interrompe l’ulteriore elaborazione del messaggio (ad eccezione dei passi successivi).
  5. Viene chiamato il metodo Application.IsPreProcessMessage .
    1. Se nessun controllo ha catturato il mouse, viene chiamato il metodo PreProcessMessage del controllo focalizzato, che non esegue nulla per impostazione predefinita. Nessun controllo nel VCL ha annullato questo metodo.
  6. Viene chiamato il metodo Application.IsHintMsg .
    1. La finestra suggerimento triggers gestisce il messaggio in un metodo IsHintMsg sovrascritto. Non è ansible impedire che il messaggio venga elaborato ulteriormente.
  7. DispatchMessage è chiamato.
  8. Il metodo TWinControl.WndProc della finestra focalizzata riceve il messaggio. Questo messaggio è di tipo TMessage cui manca la finestra (perché è l’istanza chiamata a questo metodo).
  9. Il metodo TWinControl.IsControlMouseMsg viene chiamato per verificare se il messaggio del mouse deve essere indirizzato a uno dei controlli figlio non a finestra.
    1. Se c’è un controllo figlio che ha catturato il mouse o si trova nella posizione corrente del mouse 2) , il messaggio viene inviato al metodo WndProc del controllo figlio, vedi il punto 10. ( 2) Questo non accadrà mai , perché WM_MOUSEWHEEL contiene il suo mouse posizione nelle coordinate dello schermo e IsControlMouseMsg assume una posizione del mouse nelle coordinate del client (XE2).)
  10. Il metodo ereditato TControl.WndProc riceve il messaggio.
    1. Quando il sistema non supporta in modo nativo la rotellina del mouse (CM_MOUSEWHEEL e inviato a TControl.MouseWheelHandler , vedere il punto 13.
    2. In caso contrario, il messaggio viene inviato al gestore messaggi appropriato.
  11. Il metodo TControl.WMMouseWheel riceve il messaggio.
  12. L’ WM_MOUSEWHEEL WM_MOUSEWHEEL (significativo per il sistema e spesso anche per VCL) viene convertito in un CM_MOUSEWHEEL c ontrol m essage (significativo solo per VCL) che fornisce le informazioni di ShiftState del VCL convenienti invece dei dati delle chiavi del sistema.
  13. Viene chiamato il metodo MouseWheelHandler del controllo.
    1. Se il controllo è un TCustomForm , viene chiamato il metodo TCustomForm.MouseWheelHandler .
      1. Se è presente un controllo focalizzato, CM_MOUSEWHEEL viene inviato al controllo focalizzato, vedere il passaggio 14.
      2. Altrimenti viene chiamato il metodo ereditato, vedi il punto 13.2.
    2. In caso contrario, viene chiamato il metodo TControl.MouseWheelHandler .
      1. Se è presente un controllo che ha catturato il mouse e non ha alcun genitore 3) , il messaggio viene inviato a tale controllo, vedere il punto 8 o 10, a seconda del tipo di controllo. ( 3) Questo non accadrà mai , perché Capture è ottenuto con GetCaptureControl , che controlla Parent <> nil (XE2).)
      2. Se il controllo si trova su un modulo, viene chiamato MouseWheelHandler del modulo di controllo, vedere il passaggio 13.1.
      3. In caso contrario, o se il controllo è il modulo, CM_MOUSEWHEEL viene inviato al controllo, vedere il passaggio 14.
  14. Il metodo TControl.CMMouseWheel riceve il messaggio.
    1. Viene chiamato il metodo TControl.DoMouseWheel .
      1. L’evento OnMouseWheel è OnMouseWheel .
      2. Se non gestito, viene chiamato TControl.DoMouseWheelDown o TControl.DoMouseWheelUp , in base alla direzione di scorrimento.
      3. L’ OnMouseWheelDown o OnMouseWheelUp viene OnMouseWheelUp .
    2. Se non viene gestito, CM_MOUSEWHEEL viene inviato al controllo genitore, vedere il passaggio 14. (Credo che questo sia contrario al consiglio dato da MSDN nella citazione sopra, ma che indubbiamente è una decisione ponderata presa dagli sviluppatori. Forse perché ciò potrebbe iniziare questa stessa catena finita).

Osservazioni, osservazioni e considerazioni

In quasi tutti i passaggi di questa catena di elaborazione il messaggio può essere ignorato senza fare nulla, modificato modificando i parametri del messaggio, gestito agendo su di esso e annullato impostando Handled := True o impostando Message.Result su un valore diverso da zero.

Solo quando alcuni controlli hanno lo stato attivo, questo messaggio viene ricevuto dall’applicazione. Ma anche quando Screen.ActiveCustomForm.ActiveControl viene forzosamente impostato su nil , il VCL garantisce un controllo focalizzato con TCustomForm.SetWindowFocus , che per impostazione predefinita è il modulo precedentemente attivo. (Con Windows.SetFocus(0) , infatti, il messaggio non viene mai inviato.)

A causa del bug in IsControlMouseMsg 2) , un TControl può ricevere il messaggio WM_MOUSEWHEEL solo se ha catturato il mouse. Questo può essere ottenuto manualmente impostando Control.MouseCapture := True , ma devi prestare particolare attenzione a rilasciarlo rapidamente, altrimenti avrà effetti collaterali indesiderati come la necessità di un clic extra non necessario per ottenere qualcosa. Inoltre, l’ acquisizione del mouse avviene in genere solo tra un mouse down e un evento mouse up, ma questa restrizione non deve necessariamente essere applicata. Ma anche quando il messaggio raggiunge il controllo, viene inviato al suo metodo MouseWheelHandler che lo rimanda alla forma o al controllo attivo. Pertanto, i controlli VCL non a finestra non possono mai agire sul messaggio per impostazione predefinita. Credo che questo sia un altro bug, altrimenti perché la gestione di tutte le ruote è stata implementata in TControl ? Gli scrittori di componenti possono aver implementato il proprio metodo MouseWheelHandler proprio per questo scopo, e qualunque sia la soluzione a questa domanda, ci si deve occupare di non rompere questo tipo di personalizzazione esistente.

I controlli nativi che sono in grado di scorrere con la rotella, come TMemo , TListBox , TDateTimePicker , TComboBox , TTreeView , TListView , ecc. Vengono fatti scorrere dal sistema stesso. L’invio di CM_MOUSEWHEEL a tale controllo non ha alcun effetto per impostazione predefinita. Questi comandi derivati ​​dalla sottoclass scorrono come risultato del messaggio WM_MOUSEWHEEL inviato alla procedura della finestra API associata alla sottoclass con CallWindowProc , di cui VCL si occupa in TWinControl.DefaultHandler . Stranamente, questa routine non controlla Message.Result prima di chiamare CallWindowProc , e una volta che il messaggio è stato inviato, lo scorrimento non può essere impedito. Il messaggio ritorna con il suo Result impostato a seconda che il controllo sia normalmente in grado di scorrere o sul tipo di controllo. (Ad esempio, un TMemo restituisce <> 0 e TEdit restituisce 0 ) Lo TEdit effettivo non ha alcuna influenza sul risultato del messaggio.

I controlli VCL si basano sulla gestione predefinita implementata in TControl e TWinControl , come illustrato sopra. Agiscono sugli eventi ruota in DoMouseWheel , DoMouseWheelDown o DoMouseWheelUp . Per quanto ne so, nessun controllo nel VCL ha sovrascritto MouseWheelHandler per gestire gli eventi ruota.

Osservando le diverse applicazioni, non sembra esserci alcuna conformità su quale sia il comportamento dello scroll wheel. Ad esempio: MS Word scorre la pagina che è al passaggio del mouse, MS Excel scorre la cartella di lavoro focalizzata, Windows Eplorer scorre il riquadro focalizzato, i siti web implementano il comportamento di scorrimento in modo molto diverso, Evernote scorre la finestra che si libra, ecc … E Delphi il proprio IDE supera ogni cosa scorrendo la finestra focalizzata e la finestra al passaggio del mouse, tranne quando si passa il mouse sull’editor di codice, quindi l’editor di codice ruba lo stato attivo quando si scorre (XE2).

Fortunatamente Microsoft offre almeno delle linee guida sull’esperienza utente per le applicazioni desktop basate su Windows :

  • Fai ruotare la rotella del mouse sul controllo, sul pannello o sulla finestra in cui il puntatore si trova al momento. Ciò evita risultati indesiderati.
  • Fai ruotare la rotellina del mouse senza fare clic o avere il focus di input. Hovering è sufficiente.
  • Fai ruotare la rotella del mouse sull’object con l’ambito più specifico. Ad esempio, se il puntatore si trova su un controllo scrollabile della casella di riepilogo in un riquadro scorrevole all’interno di una finestra scorrevole, la rotella del mouse influisce sul controllo della casella di riepilogo.
  • Non modificare il focus di input quando si utilizza la rotellina del mouse.

Quindi il requisito della domanda di far scorrere solo il controllo in volo ha abbastanza motivi, ma gli sviluppatori di Delphi non hanno reso facile implementarlo.

Conclusione e soluzione

La soluzione preferita è una senza sottoclass di windows o implementazioni multiple per diverse forms o controlli.

Per impedire lo scorrimento del controllo focalizzato, il controllo potrebbe non ricevere il messaggio CM_MOUSEWHEEL . Pertanto, MouseWheelHandler di qualsiasi controllo non può essere chiamato. Pertanto, WM_MOUSEWHEEL potrebbe non essere inviato a nessun controllo. Quindi l’unico posto rimasto per l’intervento è TApplication.OnMessage . Inoltre, il messaggio potrebbe non scappare da esso, quindi tutta la gestione dovrebbe aver luogo in quel gestore di eventi e quando viene ignorata tutta la gestione delle ruote VCL di default, si deve prendere in considerazione ogni condizione ansible.

Iniziamo semplice. La finestra abilitata che è attualmente al passaggio del 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 otteniamo un riferimento al controllo VCL. Se il risultato è nil , la finestra al passaggio del mouse non appartiene al processo dell’applicazione, oppure è una finestra non nota al VCL (ad esempio un TDateTimePicker discesa). In tal caso, il messaggio deve essere inoltrato all’API e il risultato a cui non siamo interessati.

  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; 

Quando la finestra è un controllo VCL, è necessario considerare più gestori di messaggi chiamando in un ordine specifico. Quando è presente un controllo non a finestra abilitato (di tipo TControl o discendente) nella posizione del mouse, è necessario prima ottenere un messaggio CM_MOUSEWHEEL perché tale controllo è sicuramente il controllo in primo piano. Il messaggio deve essere costruito dal messaggio WM_MOUSEWHEEL e tradotto nel suo equivalente VCL. In secondo luogo, il messaggio WM_MOUSEWHEEL deve essere inviato al metodo DefaultHandler del controllo per consentire la gestione dei controlli nativi. E infine, ancora una volta il messaggio CM_MOUSEWHEEL deve essere inviato al controllo quando nessun gestore precedente si è occupato del messaggio. Questi ultimi due passaggi non possono essere eseguiti in ordine inverso perché ad es. Un memo su una casella di scorrimento deve poter scorrere anche.

  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; 

Quando una finestra ha catturato il mouse, è necessario che vengano inviati tutti i messaggi a ruota. La finestra recuperata da GetCapture è garantita per essere una finestra del processo corrente, ma non deve essere un controllo VCL. Ad esempio durante un’operazione di trascinamento, viene creata una finestra temporanea (vedere TDragObject.DragHandle ) che riceve i messaggi del mouse. Tutti i messaggi? Noooo, WM_MOUSEWHEEL non viene inviato alla finestra di acquisizione, quindi dobbiamo reindirizzarlo. Inoltre, quando la finestra di acquisizione non gestisce il messaggio, tutte le altre elaborazioni precedentemente trattate dovrebbero aver luogo. Questa è una caratteristica che manca nel VCL: quando si Form.OnMouseWheel trascinamento durante un’operazione di trascinamento, viene chiamato effettivamente Form.OnMouseWheel , ma il controllo focalizzato o triggersto non riceve il messaggio. Ciò significa ad esempio che un testo non può essere trascinato nel contenuto di un memo in una posizione che si trova oltre la parte visibile del memo.

  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; 

Questo essenzialmente fa il lavoro, ed era la base per l’unità presentata di seguito. Per farlo funzionare, basta aggiungere il nome dell’unità a una delle clausole di utilizzo nel progetto. Ha le seguenti funzionalità aggiuntive:

  • La possibilità di visualizzare in anteprima un’azione rotella nella forma principale, nella forma triggers o nel controllo attivo.
  • Registrazione delle classi di controllo per le quali è necessario chiamare il loro metodo MouseWheelHandler .
  • La possibilità di portare questo object TApplicationEvents davanti a tutti gli altri.
  • La possibilità di annullare l’ OnMessage dell’evento OnMessage a tutti gli altri oggetti TApplicationEvents .
  • La possibilità di consentire ancora la gestione VCL predefinita in seguito per scopi analitici o di test.

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 (eg 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. 

Disclaimer:

Questo codice non scorre intenzionalmente nulla, prepara solo il routing dei messaggi per gli eventi OnMouseWheel* VCL per ottenere l’opportunità appropriata di essere licenziati. Questo codice non è testato su controlli di terze parti. Quando VclHandlingAfterHandled o VclHandlingAfterUnhandled è impostato su True , gli eventi del mouse possono essere triggersti ​​due volte. In questo post ho fatto alcune affermazioni e ho considerato che ci fossero tre bug nel VCL, comunque, tutto basato sullo studio della documentazione e dei test. Si prega di testare questa unità e commentare risultati e bug. Mi scuso per questa risposta piuttosto lunga; Semplicemente non ho un blog.

1) Denominazione sfacciata tratta da Odyssey di A Key

2) Vedi il mio bug report sulla qualità centrale # 135258

3) Vedi il mio bug report sulla qualità centrale # 135305

Sovrascrivere l’evento TApplication.OnMessage (o creare un componente TApplicationEvents) e redirect il messaggio WM_MOUSEWHEEL nel gestore eventi:

 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; 

Funziona bene qui, anche se potresti voler aggiungere qualche protezione per evitare che si ripeta se succede qualcosa di inaspettato.

Potresti trovare utile questo articolo: inviare un messaggio scroll down a listbox usando mousewheel, ma listbox non ha focus [1] , è scritto in C #, ma la conversione in Delphi non dovrebbe essere un problema troppo grande. Usa i ganci per realizzare l’effetto desiderato.

Per scoprire quale componente il mouse è attualmente finito, è ansible utilizzare la funzione FindVCLWindow, un esempio di questo si può trovare in questo articolo: Ottieni il controllo sotto il mouse in un’applicazione 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

Questa è la soluzione che ho usato:

  1. Aggiungi amMouseWheel alla clausola uses della sezione di implementazione dell’unità del modulo dopo l’unità forms :

     unit MyUnit; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, // Fix and util for mouse wheel amMouseWheel; ... 
  2. Salva il seguente codice su 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 (eg 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. 

Ho avuto lo stesso problema e l’ho risolto con qualche piccolo trucco, ma funziona.

Non volevo scherzare con i messaggi e ho deciso solo di chiamare il metodo DoMouseWheel per il controllo di cui avevo bisogno. Hack è che DoMouseWheel è un metodo protetto e quindi non accessibile dal file dell’unità modulo, ecco perché ho definito la mia class in unità modulo:

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

Quindi ho scritto il gestore di eventi 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; 

Come vedi, cerca tutti i controlli sul modulo, non solo i bambini immediati, e cerca di cercare tra genitori e figli. Sarebbe meglio (ma più codice) fare ricerche ricorsive sui bambini, ma il codice sopra funziona perfettamente.

Per fare in modo che un solo controllo risponda all’evento della rotellina, è necessario impostare sempre Handled: = true quando è implementato. Se ad esempio hai una lista all’interno del pannello, il pannello eseguirà prima DoMouseWheel e, se non gestisce l’evento, eseguirà listbox.DoMouseWheel. Se nessun controllo sotto il cursore del mouse è gestito da DoMouseWheel, il controllo focalizzato sembrerà piuttosto adeguato.

Solo per l’utilizzo con i controlli DevExpress

Funziona su XE3. Non è stato testato su altre versioni.

 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; 

se non si usano i controlli DevExpress, quindi Perform -> SendMessage

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

Nell’evento OnMouseEnter per ciascun controllo scorrevole, aggiungere una rispettiva chiamata a SetFocus

Quindi per ListBox1:

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

Questo raggiunge l’effetto desiderato?