TListView and mouse wheel scrolling

后端 未结 1 958
[愿得一人]
[愿得一人] 2020-12-14 04:52

I have a TListView component in a form. It\'s quite long and I want user to able scroll it, if mouse is over the component and wheel is scrolled. I do not find any OnMouseWh

相关标签:
1条回答
  • 2020-12-14 05:18

    Here's my code to do this:

    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 is quite nifty. It works for any control with a vertical scroll bar. I use it with tree views, list views, list boxes, memos, rich edits, etc.

    You'll be missing my ModifierKeyState routine but you can substitute your own method for checking that the wheel event is not modified. The reason you want to do this is the, for example, CTRL+mouse wheel means zoom rather than scroll.

    For what it's worth, it looks like this:

    type
      TModifierKey = ssShift..ssCtrl;
      TModifierKeyState = set of TModifierKey;
    
    function ModifierKeyState(Shift: TShiftState): TModifierKeyState;
    const
      AllModifierKeys = [low(TModifierKey)..high(TModifierKey)];
    begin
      Result := AllModifierKeys*Shift;
    end;
    
    0 讨论(0)
提交回复
热议问题