win32: mouse-leave events when mouse leaves the frame
original commit: 4c05bb48f128c1885c122835eb29755f2a9535b1
This commit is contained in:
parent
8744d5c5b5
commit
c54649bd9e
|
@ -116,6 +116,20 @@
|
||||||
[cbData _DWORD]
|
[cbData _DWORD]
|
||||||
[lpData _pointer]))
|
[lpData _pointer]))
|
||||||
|
|
||||||
|
(define-cstruct _TRACKMOUSEEVENT
|
||||||
|
([cbSize _DWORD]
|
||||||
|
[dwFlags _DWORD]
|
||||||
|
[hwndTrack _HWND]
|
||||||
|
[dwHoverTime _DWORD]))
|
||||||
|
|
||||||
|
(define TME_LEAVE #x02)
|
||||||
|
(define TME_NONCLIENT #x10)
|
||||||
|
|
||||||
|
(define-user32 TrackMouseEvent (_wfun _TRACKMOUSEEVENT-pointer -> (r : _BOOL)
|
||||||
|
-> (unless r (failed 'TrackMouseEvent))))
|
||||||
|
(define-user32 GetCursorPos (_wfun _POINT-pointer -> (r : _BOOL)
|
||||||
|
-> (unless r (failed 'GetCursorPos))))
|
||||||
|
|
||||||
(defclass window% object%
|
(defclass window% object%
|
||||||
(init-field parent hwnd)
|
(init-field parent hwnd)
|
||||||
(init style
|
(init style
|
||||||
|
@ -524,7 +538,11 @@
|
||||||
[(= msg WM_MOUSEMOVE)
|
[(= msg WM_MOUSEMOVE)
|
||||||
(do-mouse w msg #f 'motion wParam lParam)]
|
(do-mouse w msg #f 'motion wParam lParam)]
|
||||||
[(= msg WM_MOUSELEAVE)
|
[(= msg WM_MOUSELEAVE)
|
||||||
(do-mouse w msg #f 'leave wParam lParam)]
|
(let ([p (make-POINT 0 0)])
|
||||||
|
(GetCursorPos p)
|
||||||
|
(let ([f (location->window (POINT-x p) (POINT-y p))])
|
||||||
|
(unless (eq? f (get-top-frame))
|
||||||
|
(do-mouse w msg #f 'leave wParam lParam))))]
|
||||||
[else #f]))
|
[else #f]))
|
||||||
|
|
||||||
(define/private (do-mouse control-hwnd msg nc? type wParam lParam)
|
(define/private (do-mouse control-hwnd msg nc? type wParam lParam)
|
||||||
|
@ -556,6 +574,11 @@
|
||||||
[alt-down #f]
|
[alt-down #f]
|
||||||
[time-stamp 0]
|
[time-stamp 0]
|
||||||
[caps-down #f]))])
|
[caps-down #f]))])
|
||||||
|
(if (eq? type 'leave)
|
||||||
|
(let ([t (get-top-frame)])
|
||||||
|
(send t send-child-leaves make-e)
|
||||||
|
(send t send-leaves make-e))
|
||||||
|
(begin
|
||||||
(unless nc?
|
(unless nc?
|
||||||
(when (wants-mouse-capture? control-hwnd)
|
(when (wants-mouse-capture? control-hwnd)
|
||||||
(when (memq type '(left-down right-down middle-down))
|
(when (memq type '(left-down right-down middle-down))
|
||||||
|
@ -563,13 +586,18 @@
|
||||||
(when (memq type '(left-up right-up middle-up))
|
(when (memq type '(left-up right-up middle-up))
|
||||||
(ReleaseCapture))))
|
(ReleaseCapture))))
|
||||||
(if mouse-in?
|
(if mouse-in?
|
||||||
(if (send-child-leaves (lambda (type) (make-e type)))
|
(if (send-child-leaves make-e)
|
||||||
(cursor-updated-here)
|
(cursor-updated-here)
|
||||||
(if (send (get-top-frame) is-wait-cursor-on?)
|
(if (send (get-top-frame) is-wait-cursor-on?)
|
||||||
(void (SetCursor (get-wait-cursor)))
|
(void (SetCursor (get-wait-cursor)))
|
||||||
(when effective-cursor-handle
|
(when effective-cursor-handle
|
||||||
(void (SetCursor effective-cursor-handle)))))
|
(void (SetCursor effective-cursor-handle)))))
|
||||||
(let ([c (generate-mouse-ins this (lambda (type) (make-e type)))])
|
(let ([c (generate-mouse-ins this (lambda (type) (make-e type)))])
|
||||||
|
(TrackMouseEvent (make-TRACKMOUSEEVENT
|
||||||
|
(ctype-sizeof _TRACKMOUSEEVENT)
|
||||||
|
(bitwise-ior TME_LEAVE)
|
||||||
|
control-hwnd
|
||||||
|
0))
|
||||||
(when c
|
(when c
|
||||||
(set! effective-cursor-handle c)
|
(set! effective-cursor-handle c)
|
||||||
(void (SetCursor (if (send (get-top-frame) is-wait-cursor-on?)
|
(void (SetCursor (if (send (get-top-frame) is-wait-cursor-on?)
|
||||||
|
@ -577,7 +605,7 @@
|
||||||
c))))))
|
c))))))
|
||||||
(when (memq type '(left-down right-down middle-down))
|
(when (memq type '(left-down right-down middle-down))
|
||||||
(set-focus))
|
(set-focus))
|
||||||
(handle-mouse-event control-hwnd msg wParam (make-e type)))))
|
(handle-mouse-event control-hwnd msg wParam (make-e type)))))))
|
||||||
|
|
||||||
(define/private (handle-mouse-event w msg wParam e)
|
(define/private (handle-mouse-event w msg wParam e)
|
||||||
(if (definitely-wants-event? w msg wParam e)
|
(if (definitely-wants-event? w msg wParam e)
|
||||||
|
@ -604,6 +632,7 @@
|
||||||
(send parent generate-mouse-ins this mk))
|
(send parent generate-mouse-ins this mk))
|
||||||
|
|
||||||
(define/public (send-leaves mk)
|
(define/public (send-leaves mk)
|
||||||
|
(when mouse-in?
|
||||||
(set! mouse-in? #f)
|
(set! mouse-in? #f)
|
||||||
(when mk
|
(when mk
|
||||||
(let ([e (mk 'leave)])
|
(let ([e (mk 'leave)])
|
||||||
|
@ -611,7 +640,7 @@
|
||||||
(eventspace-handler-thread eventspace))
|
(eventspace-handler-thread eventspace))
|
||||||
(handle-mouse-event (get-client-hwnd) 0 0 e)
|
(handle-mouse-event (get-client-hwnd) 0 0 e)
|
||||||
(queue-window-event this
|
(queue-window-event this
|
||||||
(lambda () (dispatch-on-event/sync e)))))))
|
(lambda () (dispatch-on-event/sync e))))))))
|
||||||
|
|
||||||
(define/public (send-child-leaves mk)
|
(define/public (send-child-leaves mk)
|
||||||
#f)
|
#f)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user