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

win32: avoid continued failure when painting fails

Browse Source 
original commit: a5c4863848279b205411aa8ce2400ff02afc3a32
This commit is contained in:
Matthew Flatt 2010-12-10 19:57:05 -07:00
parent a0d21c5c08
commit b80ef37630
2 changed files with 18 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -155,23 +155,24 @@
[(= msg WM_PAINT) [(= msg WM_PAINT)
(let* ([ps (malloc 128)] (let* ([ps (malloc 128)]
[hdc (BeginPaint w ps)]) [hdc (BeginPaint w ps)])
(if for-gl? (when hdc
(queue-paint) (if for-gl?
(if (positive? paint-suspended) (queue-paint)
(set! suspended-refresh? #t) (if (positive? paint-suspended)
(let* ([hbrush (if no-autoclear? (set! suspended-refresh? #t)
#f (let* ([hbrush (if no-autoclear?
(if transparent? #f
background-hbrush (if transparent?
(CreateSolidBrush bg-colorref)))]) background-hbrush
(when hbrush (CreateSolidBrush bg-colorref)))])
(let ([r (GetClientRect canvas-hwnd)]) (when hbrush
(FillRect hdc r hbrush)) (let ([r (GetClientRect canvas-hwnd)])
(unless transparent? (FillRect hdc r hbrush))
(DeleteObject hbrush))) (unless transparent?
(unless (do-canvas-backing-flush hdc) (DeleteObject hbrush)))
(queue-paint))))) (unless (do-canvas-backing-flush hdc)
(EndPaint hdc ps)) (queue-paint)))))
(EndPaint hdc ps)))
0] 0]
[(= msg WM_NCPAINT) [(= msg WM_NCPAINT)
(if control-border-theme (if control-border-theme

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

@ -56,8 +56,6 @@
-> (unless r (failed 'ClientToScreen)))) -> (unless r (failed 'ClientToScreen))))
(define-gdi32 CreateFontIndirectW (_wfun _LOGFONT-pointer -> _HFONT)) (define-gdi32 CreateFontIndirectW (_wfun _LOGFONT-pointer -> _HFONT))
(define-user32 FillRect (_wfun _HDC _RECT-pointer _HBRUSH -> (r : _int)
-> (when (zero? r) (failed 'FillRect))))
(define-shell32 DragAcceptFiles (_wfun _HWND _BOOL -> _void)) (define-shell32 DragAcceptFiles (_wfun _HWND _BOOL -> _void))