我在表单中有一个TListView组件。它非常长,我希望用户能够在鼠标悬停在组件上并滚动鼠标滚轮时进行滚动。我没有找到任何TListView对象的OnMouseWheel、OnMouseWheelDown或OnMouseWheelUp事件。我该如何做呢?
敬礼, evilone
我在表单中有一个TListView组件。它非常长,我希望用户能够在鼠标悬停在组件上并滚动鼠标滚轮时进行滚动。我没有找到任何TListView对象的OnMouseWheel、OnMouseWheelDown或OnMouseWheelUp事件。我该如何做呢?
敬礼, evilone
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;
TControl.WndProc()
中的代码,我终于弄清楚了:滚轮消息不一定是WM_MOUSEWHEEL(因为WM_MOUSEWHEEL等于WM_MOUSELAST)。这就是为什么(a)我并不总是收到消息,(b)有时我会收到两次消息。谢谢并点赞。 - Cosmin PrundDelphi
在TControl.WndProc
中为奇怪的WM_MOUSEWHEEL实现了一个好的hack。 - Cosmin Prund