TListView y desplazamiento de la rueda del mouse

Question

Tengo un componente TListView en un formulario. Es bastante largo y quiero que el usuario pueda desplazarlo, si el mouse está sobre el componente y se desplaza la rueda. No encuentro ningún evento OnMouseWheel, OnMouseWheelDown o OnMouseWheelUp para el objeto TListView. ¿Cómo puedo hacer eso?

Saludos, evilone

Answer 1

Aquí está mi código para hacer esto:

type 
    TMyListView = class(TListView) 
    protected 
    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override; 
    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override; 
    end; 

type  
    TMouseWheelDirection = (mwdUp, mwdDown); 

function GenericMouseWheel(Handle: HWND; Shift: TShiftState; WheelDirection: TMouseWheelDirection): Boolean; 
var 
    i, ScrollCount, Direction: Integer; 
    Paging: Boolean; 
begin 
    Result := ModifierKeyState(Shift)=[];//only respond to un-modified wheel actions 
    if Result then begin 
    Paging := DWORD(Mouse.WheelScrollLines)=WHEEL_PAGESCROLL; 
    ScrollCount := Mouse.WheelScrollLines; 
    case WheelDirection of 
    mwdUp: 
     if Paging then begin 
     Direction := SB_PAGEUP; 
     ScrollCount := 1; 
     end else begin 
     Direction := SB_LINEUP; 
     end; 
    mwdDown: 
     if Paging then begin 
     Direction := SB_PAGEDOWN; 
     ScrollCount := 1; 
     end else begin 
     Direction := SB_LINEDOWN; 
     end; 
    end; 
    for i := 1 to ScrollCount do begin 
     SendMessage(Handle, WM_VSCROLL, Direction, 0); 
    end; 
    end; 
end; 

function TMyListView.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; 
begin 
    //don't call inherited 
    Result := GenericMouseWheel(Handle, Shift, mwdDown); 
end; 

function TMyListView.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; 
begin 
    //don't call inherited 
    Result := GenericMouseWheel(Handle, Shift, mwdUp); 
end; 

GenericMouseWheel es bastante ingenioso. Funciona para cualquier control con una barra de desplazamiento vertical. Lo uso con vistas de árbol, vistas de lista, cuadros de lista, notas, ediciones enriquecidas, etc.

Te perderás mi rutina ModifierKeyState, pero puedes sustituir tu propio método para comprobar que el evento de la rueda no se modifique. La razón por la que desea hacer esto es, por ejemplo, CTRL + rueda del mouse significa acercar o alejar.

Por lo que vale la pena, que se parece a esto:

type 
    TModifierKey = ssShift..ssCtrl; 
    TModifierKeyState = set of TModifierKey; 

function ModifierKeyState(Shift: TShiftState): TModifierKeyState; 
const 
    AllModifierKeys = [low(TModifierKey)..high(TModifierKey)]; 
begin 
    Result := AllModifierKeys*Shift; 
end;