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 ] } { [ t ] [ "bad button" throw ] }
} cond ; } cond ;
: capture-mouse? ( umsg -- ? )
{ WM_LBUTTONDOWN WM_RBUTTONDOWN } member? ;
: prepare-mouse ( hWnd uMsg wParam lParam -- button coordinate world ) : prepare-mouse ( hWnd uMsg wParam lParam -- button coordinate world )
nip >r mouse-event>gesture r> mouse-coordinate rot window ; nip >r mouse-event>gesture r> mouse-coordinate rot window ;
: handle-wm-buttondown ( hWnd uMsg wParam lParam -- ) : 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 ; prepare-mouse send-button-down ;
: handle-wm-buttonup ( hWnd uMsg wParam lParam -- ) : handle-wm-buttonup ( hWnd uMsg wParam lParam -- )
ReleaseCapture drop pick capture-mouse? [ ReleaseCapture drop ] when
prepare-mouse send-button-up ; prepare-mouse send-button-up ;
: handle-wm-mousemove ( hWnd uMsg wParam lParam -- ) : handle-wm-mousemove ( hWnd uMsg wParam lParam -- )