Да да. Я удивляюсь как Иван не заметил.
Фишка в том, что сообщения Wheel не буферизуются
Собсна вот виновник:
Код:
PROCEDURE WheelScroll (wnd: WinApi.HANDLE; wParam, lParam: INTEGER);
VAR w: Window; res, lines, delta, keys: INTEGER; msg: Controllers.WheelMsg;
p: WinApi.POINT;
BEGIN
delta := wParam DIV 10000H; keys := wParam MOD 10000H;
w := ThisWindow(wnd);
lines := 3;
res := WinApi.SystemParametersInfoW(104 (*SPI_GETWHEELSCROLLLINES*), 0, SYSTEM.ADR(lines), 0);
p.x := lParam MOD 65536; p.y := lParam DIV 65536;
res := WinApi.ScreenToClient(wnd, p);
msg.x := p.x * w.port.unit; msg.y := p.y * w.port.unit;
msg.nofLines := 0; msg.op := -1;
IF lines > 10 THEN (* scroll pages *)
INC(w.wheelPos, delta);
IF w.wheelPos >= 120 THEN
msg.op := Controllers.decPage;
DEC(w.wheelPos, 120)
ELSIF w.wheelPos <= -120 THEN
msg.op := Controllers.incPage;
INC(w.wheelPos, 120)
END
ELSIF lines > 0 THEN
INC(w.wheelPos, delta * lines);
WHILE w.wheelPos >= 120 DO
msg.op := Controllers.decLine;
INC(msg.nofLines);
DEC(w.wheelPos, 120)
END;
WHILE w.wheelPos <= -120 DO
msg.op := Controllers.incLine;
INC(msg.nofLines);
INC(w.wheelPos, 120)
END
END;
msg.done := FALSE;
IF msg.op >= 0 THEN w.ForwardCtrlMsg(msg) END;
IF ~msg.done THEN (* scroll document *)
CASE msg.op OF
| Controllers.decPage:
w.Scroll(WinApi.SB_PAGEUP, 0, ODD(keys DIV 8), ~ODD(keys DIV 4))
| Controllers.incPage:
w.Scroll(WinApi.SB_PAGEDOWN, 0, ODD(keys DIV 8), ~ODD(keys DIV 4))
| Controllers.decLine:
WHILE msg.nofLines > 0 DO
w.Scroll(WinApi.SB_LINEUP, 0, ODD(keys DIV 8), ~ODD(keys DIV 4));
DEC(msg.nofLines)
END
| Controllers.incLine:
WHILE msg.nofLines > 0 DO
w.Scroll(WinApi.SB_LINEDOWN, 0, ODD(keys DIV 8), ~ODD(keys DIV 4));
DEC(msg.nofLines)
END
ELSE
END
(*
IF lines > 10 THEN (* scroll pages *)
INC(w.wheelPos, delta);
IF w.wheelPos >= 120 THEN
w.Scroll(WinApi.SBPageUp, 0, ODD(keys DIV 8), ~ODD(keys DIV 4));
DEC(w.wheelPos, 120)
ELSIF w.wheelPos <= -120 THEN
w.Scroll(WinApi.SBPageDown, 0, ODD(keys DIV 8), ~ODD(keys DIV 4));
INC(w.wheelPos, 120)
END
ELSIF lines > 0 THEN
INC(w.wheelPos, delta * lines);
WHILE w.wheelPos >= 120 DO
w.Scroll(WinApi.SBLineUp, 0, ODD(keys DIV 8), ~ODD(keys DIV 4));
DEC(w.wheelPos, 120)
END;
WHILE w.wheelPos <= -120 DO
w.Scroll(WinApi.SBLineDown, 0, ODD(keys DIV 8), ~ODD(keys DIV 4));
INC(w.wheelPos, 120)
END
END
*)
END
END WheelScroll;
Особенно циклы улыбают
Буфер конечно не тут должен быть, а в диспетчере над вьюхой.
С другой стороны можно и тут... вот только другие вьюхи потеряют возможность получать детальный Wheel