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

win32: fix canvas% control border drawing

Browse Source 
Use the system-supplied region to intersect with the
window region, so that drawng the border doesn't replace
the window content.

See also Kieron Hardy's post on the users' list, 2/7/12.

original commit: af62391c8cf8204b96299a0906e2e8656b921213
This commit is contained in:
Matthew Flatt 2012-02-11 08:23:59 -07:00
parent 5ee24043d5
commit 233cfe5643
1 changed files with 9 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/mred/private/wx/win32/canvas.rkt
View File

@ -41,6 +41,7 @@
(define-user32 GetDCEx (_wfun _HWND _HRGN _DWORD -> _HDC)) (define-user32 GetDCEx (_wfun _HWND _HRGN _DWORD -> _HDC))
(define DCX_WINDOW #x00000001) (define DCX_WINDOW #x00000001)
(define DCX_CACHE #x00000002) (define DCX_CACHE #x00000002)
(define DCX_INTERSECTRGN #x00000080)
(define EP_EDITTEXT 1) (define EP_EDITTEXT 1)
(define ETS_NORMAL 1) (define ETS_NORMAL 1)
@ -205,7 +206,14 @@
(if control-border-theme (if control-border-theme
(let* ([r (GetWindowRect canvas-hwnd)] (let* ([r (GetWindowRect canvas-hwnd)]
[res (default w msg wParam lParam)] [res (default w msg wParam lParam)]
[hdc (GetDCEx canvas-hwnd #f (bitwise-ior DCX_CACHE DCX_WINDOW))] [hrgn (if (= wParam 1) ;; check is needed for Win7
#f
(cast wParam _intptr _HRGN))]
[hdc (GetDCEx canvas-hwnd hrgn
(bitwise-ior DCX_CACHE DCX_WINDOW
(if hrgn
DCX_INTERSECTRGN
0)))]
[wr (make-RECT 0 0 [wr (make-RECT 0 0
(- (RECT-right r) (RECT-left r)) (- (RECT-right r) (RECT-left r))
(- (RECT-bottom r) (RECT-top r)))]) (- (RECT-bottom r) (RECT-top r)))])