我在表单中有一个TListView组件。它很长,我希望用户能够滚动它,如果鼠标在组件上方并滚动滚轮。我没有为TListView对象找到任何OnMouseWheel,OnMouseWheelDown或OnMouseWheelUp事件。我怎么能这样做?
此致 evilone
答案 0 :(得分:7)
这是我的代码:
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;