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

win32: transparent canvases

Browse Source 
original commit: a6d25247283f5aef4287b78018f0cafb502f7559
This commit is contained in:
Matthew Flatt 2010-10-09 20:29:07 -06:00
parent c9d4a32c60
commit 3156ae4ee8
2 changed files with 4 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -31,6 +31,7 @@
(define _HRGN _pointer) (define _HRGN _pointer)
(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 EP_EDITTEXT 1) (define EP_EDITTEXT 1)
(define ETS_NORMAL 1) (define ETS_NORMAL 1)
@ -151,7 +152,7 @@
(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 DCX_WINDOW)] [hdc (GetDCEx canvas-hwnd #f (bitwise-ior DCX_CACHE DCX_WINDOW))]
[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)))])

6
collects/mred/private/wx/win32/wndclass.rkt
View File

@ -100,16 +100,14 @@
#f ; menu #f ; menu
"PLTFrame"))) "PLTFrame")))
(void (RegisterClassW (make-WNDCLASS CS_OWNDC (void (RegisterClassW (make-WNDCLASS 0 ; using CS_OWNDC creates trouble when resizing?
wind-proc wind-proc
0 0
0 0
hInstance hInstance
#f #f
#f #f
(let ([p (ptr-add #f (+ COLOR_WINDOW 1))]) #f ; transparent
(cpointer-push-tag! p 'HBRUSH)
p)
#f ; menu #f ; menu
"PLTCanvas"))) "PLTCanvas")))