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

win32: mouse-wheel events

Browse Source 
Closes PR 11520
This commit is contained in:
Matthew Flatt 2010-12-09 21:06:11 -07:00
parent e3c4a0ae98
commit cadc128994
2 changed files with 19 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/mred/private/wx/win32/key.rkt
View File

@ -121,8 +121,11 @@
[caps-down? (not (zero? (arithmetic-shift (GetKeyState VK_CAPITAL) -1)))] [caps-down? (not (zero? (arithmetic-shift (GetKeyState VK_CAPITAL) -1)))]
[alt-down? (= (bitwise-and (HIWORD lParam) KF_ALTDOWN) KF_ALTDOWN)]) [alt-down? (= (bitwise-and (HIWORD lParam) KF_ALTDOWN) KF_ALTDOWN)])
(let-values ([(id other-shift other-altgr other-shift-altgr) (let-values ([(id other-shift other-altgr other-shift-altgr)
(if is-char? (cond
;; wParam is a character [(symbol? wParam)
(values wParam #f #f #f)]
[is-char?
;; wParam is a character or symbol
(let ([id wParam] (let ([id wParam]
[sc (THE_SCAN_CODE lParam)]) [sc (THE_SCAN_CODE lParam)])
;; Remember scan codes to help with some key-release events: ;; Remember scan codes to help with some key-release events:
@ -153,7 +156,8 @@
(values id s a sa) (values id s a sa)
;; different AltGr ;; different AltGr
(values id s o sa))) (values id s o sa)))
(values id s a sa)))))) (values id s a sa))))))]
[else
;; wParam is a virtual key code ;; wParam is a virtual key code
(let ([id (hash-ref win32->symbol wParam #f)] (let ([id (hash-ref win32->symbol wParam #f)]
[override-mapping? (and control-down? (not alt-down?))] [override-mapping? (and control-down? (not alt-down?))]
@ -210,7 +214,7 @@
[(and (not id) is-up?) [(and (not id) is-up?)
(values (try-generate-release) #f #f #f)] (values (try-generate-release) #f #f #f)]
[else [else
(values id #f #f #f)]))))]) (values id #f #f #f)])))])])
(and id (and id
(if just-check? (if just-check?
#t #t

10
collects/mred/private/wx/win32/window.rkt
View File

@ -172,6 +172,16 @@
result)] result)]
[(= msg WM_CHAR) [(= msg WM_CHAR)
(do-key w msg wParam lParam #t #f default)] (do-key w msg wParam lParam #t #f default)]
[(= msg WM_MOUSEWHEEL)
(let ([orig-delta (quotient (HIWORD wParam) WHEEL_DELTA)])
(let loop ([delta (abs orig-delta)])
(unless (zero? delta)
(do-key w msg (if (negative? orig-delta)
'wheel-down
'wheel-up)
lParam #f #f void)
(loop (sub1 delta)))))
0]
[(= msg WM_COMMAND) [(= msg WM_COMMAND)
(let* ([control-hwnd (cast lParam _LPARAM _HWND)] (let* ([control-hwnd (cast lParam _LPARAM _HWND)]
[wx (any-hwnd->wx control-hwnd)] [wx (any-hwnd->wx control-hwnd)]