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

update hierlist for new selection drawing

Browse Source
This commit is contained in:
Matthew Flatt 2010-09-07 13:52:11 -06:00
parent 42610ccecb
commit 955df62409
1 changed files with 12 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/mrlib/hierlist/hierlist-unit.rkt
View File

@ -27,10 +27,10 @@
(define transparent (make-object brush% "WHITE" 'transparent))
(define transparent-pen (make-object pen% "WHITE" 1 'transparent))
(define black-xor-pen (make-object pen% "BLACK" 1 'hilite))
(define black-xor-pen (make-object pen% (get-highlight-background-color) 1 'solid))
(define red (make-object brush% "RED" 'solid))
(define blue (make-object brush% "BLUE" 'solid))
(define black-xor (make-object brush% "BLACK" 'hilite))
(define black-xor (make-object brush% (get-highlight-background-color) 'solid))
(define arrow-cursor (make-object cursor% 'arrow))
(define-values (up-bitmap down-bitmap up-click-bitmap down-click-bitmap)
@ -285,9 +285,17 @@
(set-max-width (if (positive? w)
w
'none)))))])]
[refresh (lambda (x y width height draw-caret background)
(super refresh x y width height
(if (and selected?
(or (not (send top show-focus))
(send top has-focus?)))
(cons 0 1)
draw-caret)
background))]
[on-paint
(lambda (pre? dc left top_ right bottom dx dy caret)
(when (and (not pre?) selected?)
(when (and pre? selected?)
(let ([b (send dc get-brush)]
[p (send dc get-pen)]
[filled? (or (not (send top show-focus))
@ -652,7 +660,7 @@
(define hierarchical-list%
(class100 editor-canvas% (parent [style '(no-hscroll)])
(inherit min-width min-height allow-tab-exit)
(inherit min-width min-height allow-tab-exit refresh)
(rename [super-on-char on-char]
[super-on-focus on-focus])
(public