suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

win32: don't handle frame non-content mouse events

Browse Source
This commit is contained in:
Matthew Flatt 2011-01-12 07:02:36 -07:00
parent 99d1cda1d5
commit e9a4650f09
2 changed files with 43 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/mred/private/wx/win32/frame.rkt
View File

@ -257,6 +257,9 @@
0]
[else (super wndproc w msg wParam lParam default)]))
(define/override (try-nc-mouse w msg wParam lParam)
#f)
(define/override (set-size x y w h)
(unless (and (= w -1) (= h -1))
(maximize #f))

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

@ -405,6 +405,14 @@
(set-box! x (POINT-x p))
(set-box! y (POINT-y p))))
(define/public (in-content? p)
(ScreenToClient (get-client-hwnd) p)
(let ([r (GetClientRect (get-client-hwnd))])
(and (< 0 (POINT-x p) (- (RECT-right r)
(RECT-left r)))
(< 0 (POINT-y p) (- (RECT-bottom r)
(RECT-top r))))))
(define/public (drag-accept-files on?)
(DragAcceptFiles (get-hwnd) on?))
@ -496,28 +504,6 @@
(define/public (try-mouse w msg wParam lParam)
(cond
[(= msg WM_NCRBUTTONDOWN)
(do-mouse w msg #t 'right-down wParam lParam)]
[(= msg WM_NCRBUTTONUP)
(do-mouse w msg #t 'right-up wParam lParam)]
[(= msg WM_NCRBUTTONDBLCLK)
(do-mouse w msg #t 'right-down wParam lParam)]
[(= msg WM_NCMBUTTONDOWN)
(do-mouse w msg #t 'middle-down wParam lParam)]
[(= msg WM_NCMBUTTONUP)
(do-mouse w msg #t 'middle-up wParam lParam)]
[(= msg WM_NCMBUTTONDBLCLK)
(do-mouse w msg #t 'middle-down wParam lParam)]
[(= msg WM_NCLBUTTONDOWN)
(do-mouse w msg #t 'left-down wParam lParam)]
[(= msg WM_NCLBUTTONUP)
(do-mouse w msg #t 'left-up wParam lParam)]
[(= msg WM_NCLBUTTONDBLCLK)
(do-mouse w msg #t 'left-down wParam lParam)]
[(and (= msg WM_NCMOUSEMOVE)
(not (= wParam HTVSCROLL))
(not (= wParam HTHSCROLL)))
(do-mouse w msg #t 'motion wParam lParam)]
[(= msg WM_RBUTTONDOWN)
(do-mouse w msg #f 'right-down wParam lParam)]
[(= msg WM_RBUTTONUP)
@ -542,10 +528,41 @@
(let ([p (make-POINT 0 0)])
(GetCursorPos p)
(let ([f (location->window (POINT-x p) (POINT-y p))])
(unless (eq? f (get-top-frame))
(unless (and (eq? f (get-top-frame))
(send f in-content? p))
(do-mouse w msg #f 'leave wParam lParam))))
;; send message on to default handling (e.g., for buttons):
#f]
[else (try-nc-mouse w msg wParam lParam)]))
;; Breaking out NC mouse operations lets us not handle
;; them for frames (where this method is overridden),
;; since handling them intereferes with the cursor and
;; resize handling for frames.
(define/public (try-nc-mouse w msg wParam lParam)
(cond
[(= msg WM_NCRBUTTONDOWN)
(do-mouse w msg #t 'right-down wParam lParam)]
[(= msg WM_NCRBUTTONUP)
(do-mouse w msg #t 'right-up wParam lParam)]
[(= msg WM_NCRBUTTONDBLCLK)
(do-mouse w msg #t 'right-down wParam lParam)]
[(= msg WM_NCMBUTTONDOWN)
(do-mouse w msg #t 'middle-down wParam lParam)]
[(= msg WM_NCMBUTTONUP)
(do-mouse w msg #t 'middle-up wParam lParam)]
[(= msg WM_NCMBUTTONDBLCLK)
(do-mouse w msg #t 'middle-down wParam lParam)]
[(= msg WM_NCLBUTTONDOWN)
(do-mouse w msg #t 'left-down wParam lParam)]
[(= msg WM_NCLBUTTONUP)
(do-mouse w msg #t 'left-up wParam lParam)]
[(= msg WM_NCLBUTTONDBLCLK)
(do-mouse w msg #t 'left-down wParam lParam)]
[(and (= msg WM_NCMOUSEMOVE)
(not (= wParam HTVSCROLL))
(not (= wParam HTHSCROLL)))
(do-mouse w msg #t 'motion wParam lParam)]
[else #f]))
(define/private (do-mouse control-hwnd msg nc? type wParam lParam)