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

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

@ -233,11 +233,11 @@
(default w msg wParam lParam))] (default w msg wParam lParam))]
[(= msg WM_HSCROLL) [(= msg WM_HSCROLL)
(when hscroll? (when hscroll?
(on-scroll-change SB_HORZ (LOWORD wParam))) (on-scroll-change SB_HORZ wParam))
0] 0]
[(= msg WM_VSCROLL) [(= msg WM_VSCROLL)
(when vscroll? (when vscroll?
(on-scroll-change SB_VERT (LOWORD wParam))) (on-scroll-change SB_VERT wParam))
0] 0]
[else [else
(when (= msg WM_GESTURE) (when (= msg WM_GESTURE)
@ -490,21 +490,26 @@
(void))) (void)))
(define/public (on-scroll e) (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 ([i (GetScrollInfo canvas-hwnd dir)])
(let ([new-pos (let* ([part (LOWORD param)]
(cond [forced-pos (and (= part SB_THUMBPOSITION)
[(= part SB_TOP) 0] (HIWORD param))]
[(= part SB_BOTTOM) (SCROLLINFO-nMax i)] [new-pos
[(= part SB_LINEUP) (max 0 (sub1 (SCROLLINFO-nPos i)))] (cond
[(= part SB_LINEDOWN) (min (SCROLLINFO-nMax i) (add1 (SCROLLINFO-nPos i)))] [forced-pos forced-pos]
[(= part SB_PAGEUP) (max 0 (- (SCROLLINFO-nPos i) (SCROLLINFO-nPage i)))] [(= part SB_TOP) 0]
[(= part SB_PAGEDOWN) (min (SCROLLINFO-nMax i) (+ (SCROLLINFO-nPos i) (SCROLLINFO-nPage i)))] [(= part SB_BOTTOM) (SCROLLINFO-nMax i)]
[(= part SB_THUMBTRACK) (SCROLLINFO-nTrackPos i)] [(= part SB_LINEUP) (max 0 (sub1 (SCROLLINFO-nPos i)))]
[else (SCROLLINFO-nPos i)])]) [(= part SB_LINEDOWN) (min (SCROLLINFO-nMax i) (add1 (SCROLLINFO-nPos i)))]
(unless (or (= new-pos (SCROLLINFO-nPos i)) [(= part SB_PAGEUP) (max 0 (- (SCROLLINFO-nPos i) (SCROLLINFO-nPage i)))]
next-scroll-is-change?) [(= part SB_PAGEDOWN) (min (SCROLLINFO-nMax i) (+ (SCROLLINFO-nPos i) (SCROLLINFO-nPage i)))]
(set! next-scroll-is-change? #f) [(= part SB_THUMBTRACK) (SCROLLINFO-nTrackPos i)]
[else (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) (set-SCROLLINFO-nPos! i new-pos)
(set-SCROLLINFO-fMask! i SIF_POS) (set-SCROLLINFO-fMask! i SIF_POS)
(SetScrollInfo canvas-hwnd dir i #t) (SetScrollInfo canvas-hwnd dir i #t)