suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Per http://msdn.microsoft.com/en-us/library/windows/desktop/dd562171(v=vs.85).aspx - adds support for SB_THUMBPOSITION events. Improves touchpad scrolling on Surface Pro 3, but not touch scrolling.

Browse Source
This commit is contained in:
Brian Mastenbrook 2015-10-04 11:41:07 -05:00 committed by Matthew Flatt
parent b842b1feec
commit d393e1a5bf
1 changed files with 21 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
gui-lib/mred/private/wx/win32/canvas.rkt
View File

@ -233,11 +233,11 @@
(default w msg wParam lParam))]
[(= msg WM_HSCROLL)
(when hscroll?
(on-scroll-change SB_HORZ (LOWORD wParam)))
(on-scroll-change SB_HORZ wParam))
0]
[(= msg WM_VSCROLL)
(when vscroll?
(on-scroll-change SB_VERT (LOWORD wParam)))
(on-scroll-change SB_VERT wParam))
0]
[else
(when (= msg WM_GESTURE)
@ -490,10 +490,14 @@
(void)))
(define/public (on-scroll e) (void))
(define/private (on-scroll-change dir part)
(define/private (on-scroll-change dir param)
(let ([i (GetScrollInfo canvas-hwnd dir)])
(let ([new-pos
(let* ([part (LOWORD param)]
[forced-pos (and (= part SB_THUMBPOSITION)
(HIWORD param))]
[new-pos
(cond
[forced-pos forced-pos]
[(= part SB_TOP) 0]
[(= part SB_BOTTOM) (SCROLLINFO-nMax i)]
[(= part SB_LINEUP) (max 0 (sub1 (SCROLLINFO-nPos i)))]
@ -502,7 +506,8 @@
[(= part SB_PAGEDOWN) (min (SCROLLINFO-nMax i) (+ (SCROLLINFO-nPos i) (SCROLLINFO-nPage i)))]
[(= part SB_THUMBTRACK) (SCROLLINFO-nTrackPos i)]
[else (SCROLLINFO-nPos i)])])
(unless (or (= new-pos (SCROLLINFO-nPos i))
(unless (or (and (= new-pos (SCROLLINFO-nPos i))
(not forced-pos))
next-scroll-is-change?)
(set! next-scroll-is-change? #f)
(set-SCROLLINFO-nPos! i new-pos)