Fix odd Windows mouse wheel behavior

db4
U-SLAVA-DFB8FF805\Slava 2008-12-01 18:20:19 -06:00
parent 8b106b6a77
commit 6d8d4b3098
1 changed files with 2 additions and 8 deletions

View File

@ -285,12 +285,8 @@ SYMBOL: nc-buttons
swap [ push ] [ delete ] if ;
: >lo-hi ( WORD -- array ) [ lo-word ] [ hi-word ] bi 2array ;
: mouse-wheel ( wParam -- array ) >lo-hi [ sgn neg ] map ;
: mouse-absolute>relative ( lparam handle -- array )
[ >lo-hi ] dip
"RECT" <c-object> [ GetWindowRect win32-error=0/f ] keep
get-RECT-top-left 2array v- ;
: mouse-wheel ( wParam -- array ) >lo-hi [ sgn neg ] map ;
: mouse-event>gesture ( uMsg -- button )
key-modifiers swap message>button
@ -340,9 +336,7 @@ SYMBOL: nc-buttons
>lo-hi swap window move-hand fire-motion ;
:: handle-wm-mousewheel ( hWnd uMsg wParam lParam -- )
wParam mouse-wheel
lParam hWnd mouse-absolute>relative
hWnd window send-wheel ;
wParam mouse-wheel hand-loc get hWnd window send-wheel ;
: handle-wm-cancelmode ( hWnd uMsg wParam lParam -- )
#! message sent if windows needs application to stop dragging