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

fix problems with canvas refresh, especially win32

Browse Source
This commit is contained in:
Matthew Flatt 2010-12-17 14:40:47 -07:00
parent 2dc15061a8
commit b07f57fc73
4 changed files with 21 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/mred/private/wx/common/canvas-mixin.rkt
View File

@ -143,7 +143,8 @@
(let ([pq paint-queued])
(when pq (set-box! pq #f)))
(set! paint-queued #f)
(when (or (not b) (is-shown-to-root?))
(cond
[(or (not b) (is-shown-to-root?))
(let ([dc (get-dc)])
(send dc suspend-flush)
(send dc ensure-ready)
@ -156,7 +157,11 @@
(send dc set-background old-bg))))
(on-paint)
(send dc resume-flush)
(queue-backing-flush))))
(queue-backing-flush))]
[b ; => not shown to root
;; invalidate dc so that it's refresh
;; when it's shown again
(send (get-dc) reset-backing-retained)]))
(when req
(cancel-canvas-flush-delay req)))

7
collects/mred/private/wx/win32/panel.rkt
View File

@ -22,16 +22,19 @@
(define children null)
(define/override (register-child child on?)
(let ([now-on? (and (memq child children) #t)])
(let ([on? (and on? #t)]
[now-on? (and (memq child children) #t)])
(unless (eq? on? now-on?)
(unless on?
(when (eq? child mouse-in-child)
(send child send-leaves #f)
(set! mouse-in-child #f)))
(set! children
(if on?
(cons child children)
(remq child children)))
(send child parent-enable (is-enabled-to-root?)))))
(when on?
(send child parent-enable (is-enabled-to-root?))))))
(define/override (internal-enable on?)
(super internal-enable on?)

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

@ -601,12 +601,13 @@
(define/public (send-leaves mk)
(set! mouse-in? #f)
(let ([e (mk 'leave)])
(if (eq? (current-thread)
(eventspace-handler-thread eventspace))
(handle-mouse-event (get-client-hwnd) 0 0 e)
(queue-window-event this
(lambda () (dispatch-on-event/sync e))))))
(when mk
(let ([e (mk 'leave)])
(if (eq? (current-thread)
(eventspace-handler-thread eventspace))
(handle-mouse-event (get-client-hwnd) 0 0 e)
(queue-window-event this
(lambda () (dispatch-on-event/sync e)))))))
(define/public (send-child-leaves mk)
#f)

3
collects/mrlib/switchable-button.rkt
View File

@ -88,7 +88,8 @@
(define/override (on-superwindow-show show?)
(unless show?
(set! in? #f)
(set! down? #f))
(set! down? #f)
(refresh))
(super on-superwindow-show show?))
(define/override (on-event evt)