win32: fix gl canvas repaint
This commit is contained in:
parent
47281a9d2d
commit
3d9f52a4d1
|
@ -89,6 +89,7 @@
|
||||||
|
|
||||||
(define hscroll? (memq 'hscroll style))
|
(define hscroll? (memq 'hscroll style))
|
||||||
(define vscroll? (memq 'vscroll style))
|
(define vscroll? (memq 'vscroll style))
|
||||||
|
(define for-gl? (memq 'gl style))
|
||||||
|
|
||||||
(define panel-hwnd
|
(define panel-hwnd
|
||||||
(and (memq 'combo style)
|
(and (memq 'combo style)
|
||||||
|
@ -155,19 +156,21 @@
|
||||||
[(= msg WM_PAINT)
|
[(= msg WM_PAINT)
|
||||||
(let* ([ps (malloc 128)]
|
(let* ([ps (malloc 128)]
|
||||||
[hdc (BeginPaint w ps)])
|
[hdc (BeginPaint w ps)])
|
||||||
(unless (positive? paint-suspended)
|
(if for-gl?
|
||||||
(let* ([hbrush (if no-autoclear?
|
(queue-paint)
|
||||||
#f
|
(unless (positive? paint-suspended)
|
||||||
(if transparent?
|
(let* ([hbrush (if no-autoclear?
|
||||||
background-hbrush
|
#f
|
||||||
(CreateSolidBrush bg-colorref)))])
|
(if transparent?
|
||||||
(when hbrush
|
background-hbrush
|
||||||
(let ([r (GetClientRect canvas-hwnd)])
|
(CreateSolidBrush bg-colorref)))])
|
||||||
(FillRect hdc r hbrush))
|
(when hbrush
|
||||||
(unless transparent?
|
(let ([r (GetClientRect canvas-hwnd)])
|
||||||
(DeleteObject hbrush)))
|
(FillRect hdc r hbrush))
|
||||||
(unless (do-backing-flush this dc hdc)
|
(unless transparent?
|
||||||
(queue-paint))))
|
(DeleteObject hbrush)))
|
||||||
|
(unless (do-backing-flush this dc hdc)
|
||||||
|
(queue-paint)))))
|
||||||
(EndPaint hdc ps))
|
(EndPaint hdc ps))
|
||||||
0]
|
0]
|
||||||
[(= msg WM_NCPAINT)
|
[(= msg WM_NCPAINT)
|
||||||
|
@ -254,7 +257,8 @@
|
||||||
(define/override (refresh) (queue-paint))
|
(define/override (refresh) (queue-paint))
|
||||||
|
|
||||||
(define/public (queue-backing-flush)
|
(define/public (queue-backing-flush)
|
||||||
(InvalidateRect canvas-hwnd #f #f))
|
(unless for-gl?
|
||||||
|
(InvalidateRect canvas-hwnd #f #f)))
|
||||||
|
|
||||||
(define/public (make-compatible-bitmap w h)
|
(define/public (make-compatible-bitmap w h)
|
||||||
(send dc make-backing-bitmap w h))
|
(send dc make-backing-bitmap w h))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user