win32: avoid continued failure when painting fails

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

View File

@ -155,6 +155,7 @@
[(= msg WM_PAINT) [(= msg WM_PAINT)
(let* ([ps (malloc 128)] (let* ([ps (malloc 128)]
[hdc (BeginPaint w ps)]) [hdc (BeginPaint w ps)])
(when hdc
(if for-gl? (if for-gl?
(queue-paint) (queue-paint)
(if (positive? paint-suspended) (if (positive? paint-suspended)
@ -171,7 +172,7 @@
(DeleteObject hbrush))) (DeleteObject hbrush)))
(unless (do-canvas-backing-flush hdc) (unless (do-canvas-backing-flush hdc)
(queue-paint))))) (queue-paint)))))
(EndPaint hdc ps)) (EndPaint hdc ps)))
0] 0]
[(= msg WM_NCPAINT) [(= msg WM_NCPAINT)
(if control-border-theme (if control-border-theme

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))