fix mouse wheel capture problems in win32 ui

erg 2006-10-07 03:05:51 +00:00
parent 5096d3c5df
commit e02c82de32
1 changed files with 5 additions and 2 deletions

View File

@ -177,15 +177,18 @@ SYMBOL: hWnd
{ [ t ] [ "bad button" throw ] }
} cond ;
: capture-mouse? ( umsg -- ? )
{ WM_LBUTTONDOWN WM_RBUTTONDOWN } member? ;
: prepare-mouse ( hWnd uMsg wParam lParam -- button coordinate world )
nip >r mouse-event>gesture r> mouse-coordinate rot window ;
: handle-wm-buttondown ( hWnd uMsg wParam lParam -- )
>r pick SetCapture drop r>
>r over capture-mouse? [ pick SetCapture drop ] when r>
prepare-mouse send-button-down ;
: handle-wm-buttonup ( hWnd uMsg wParam lParam -- )
ReleaseCapture drop
pick capture-mouse? [ ReleaseCapture drop ] when
prepare-mouse send-button-up ;
: handle-wm-mousemove ( hWnd uMsg wParam lParam -- )