TListView и прокрутка колесика мыши - PullRequest
Новая
       12

TListView и прокрутка колесика мыши

6 голосов
/ 14 марта 2011

У меня есть компонент TListView в форме. Это довольно долго, и я хочу, чтобы пользователь мог прокрутить его, если мышь находится над компонентом, а колесо прокручивается. Я не нахожу никаких событий OnMouseWheel, OnMouseWheelDown или OnMouseWheelUp для объекта TListView. Как я могу это сделать?

С уважением, evilone

1 Ответ

7 голосов
/ 14 марта 2011

Вот мой код для этого: 

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 довольно изящно. Это работает для любого элемента управления с вертикальной полосой прокрутки. Я использую его с представлениями дерева, представлениями списка, списками, заметками, расширенными правками и т. Д.

Вы пропустите мою ModifierKeyState процедуру, но вы можете заменить свой собственный метод проверки того, что событие колеса не было изменено. Причина, по которой вы хотите это сделать, заключается, например, в том, что CTRL + колесико мыши означает увеличение, а не прокрутку.

Для чего это стоит, это выглядит так: 

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

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