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

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

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

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

@ -172,6 +172,16 @@
result)]
[(= msg WM_CHAR)
(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)
(let* ([control-hwnd (cast lParam _LPARAM _HWND)]
[wx (any-hwnd->wx control-hwnd)]