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

.

Browse Source 
original commit: 566ccb30f58e84e6aa891a99e91f37eeebc68f42
This commit is contained in:
Matthew Flatt 2002-10-11 15:04:00 +00:00
parent 2431e3f435
commit 285da04a13
1 changed files with 9 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/mred/mred.ss
View File

@ -1756,8 +1756,9 @@
(cons w h))) (cons w h)))
tabs)]) tabs)])
(set! tab-widths (map car w+hs)) (set! tab-widths (map car w+hs))
(let ([th (ceiling (+ (* 2 tab-v-space) (apply max 0 (map cdr w+hs))))]) (let-values ([(sw sh sd sa) (send dc get-text-extent " " font)])
(set! tab-height (if (even? th) th (add1 th))))))) (let ([th (ceiling (+ (* 2 tab-v-space) (apply max 0 sh (map cdr w+hs))))])
(set! tab-height (if (even? th) th (add1 th))))))))
(define/private (get-total-width) (define/private (get-total-width)
(apply + tab-height (* (length tabs) (+ raise-h raise-h tab-height)) tab-widths)) (apply + tab-height (* (length tabs) (+ raise-h raise-h tab-height)) tab-widths))
@ -1923,10 +1924,10 @@
(send dc set-pen dark-pen) (send dc set-pen dark-pen)
(draw-once dc w #f #t 0) (draw-once dc w #f #t 0)
(when (> h tab-height) (when (> h tab-height)
(send dc draw-line (- w 1) tab-height (- w 1) h) (send dc draw-line (- w 1) tab-height (- w 1) (- h raise-h))
(send dc draw-line (- w 2) tab-height (- w 2) h) (send dc draw-line (- w 2) (+ 1 tab-height) (- w 2) (- h raise-h))
(send dc draw-line 0 (- h 3) w (- h 3)) (send dc draw-line 0 (- h 3 raise-h) w (- h 3 raise-h))
(send dc draw-line 0 (- h 4) w (- h 4)))) (send dc draw-line 1 (- h 4 raise-h) w (- h 4 raise-h))))
(send dc set-origin 0 0))))) (send dc set-origin 0 0)))))
(define/override (on-size w h) (define/override (on-size w h)
@ -2627,7 +2628,7 @@
#t)] #t)]
[delta-w (- (get-width) client-w)] [delta-w (- (get-width) client-w)]
[delta-h (- (get-height) client-h)]) [delta-h (- (get-height) client-h)])
(list (+ delta-w (car min-client-size)) (list (+ delta-w (car min-client-size) (if hidden-child 4 0)) ; hack: 2-pixel border
(+ delta-h (cadr min-client-size)))))))] (+ delta-h (cadr min-client-size)))))))]
; do-get-min-graphical-size: poll children and return minimum possible ; do-get-min-graphical-size: poll children and return minimum possible
@ -2762,7 +2763,7 @@
(- width 4) ;; hack! 2-pixel border assumed (- width 4) ;; hack! 2-pixel border assumed
width) width)
(if hidden-child (if hidden-child
(- height (child-info-y-min (car children-info))) (- height (child-info-y-min (car children-info))) ;; 2-pixel border here, too
height))]) height))])
(unless (and (list? l) (unless (and (list? l)
(= (length l) (- (length children-info) (if hidden-child 1 0))) (= (length l) (- (length children-info) (if hidden-child 1 0)))