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

fix fonts in some controls to use normal-control-font

Browse Source 
svn: r9583
This commit is contained in:
Matthew Flatt 2008-05-02 02:15:40 +00:00
parent f17d85c24a
commit 044922053a
2 changed files with 4 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/framework/private/frame.ss
View File

@ -716,11 +716,12 @@
(define/private (update-client-width str) (define/private (update-client-width str)
(let ([dc (get-dc)]) (let ([dc (get-dc)])
(let-values ([(cw _4) (get-client-size)] (let-values ([(cw _4) (get-client-size)]
[(tw _1 _2 _3) (send dc get-text-extent str)]) [(tw _1 _2 _3) (send dc get-text-extent str normal-control-font)])
(when (< cw tw) (when (< cw tw)
(min-client-width (inexact->exact (floor tw))))))) (min-client-width (inexact->exact (floor tw)))))))
(define/override (on-paint) (define/override (on-paint)
(let ([dc (get-dc)]) (let ([dc (get-dc)])
(send dc set-font normal-control-font)
(let-values ([(cw ch) (get-client-size)] (let-values ([(cw ch) (get-client-size)]
[(tw th _1 _2) (send dc get-text-extent str)]) [(tw th _1 _2) (send dc get-text-extent str)])
(send dc draw-text str 0 (/ (- ch th) 2))))) (send dc draw-text str 0 (/ (- ch th) 2)))))

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

@ -69,6 +69,7 @@
(- cw margin margin) (- cw margin margin)
(- ch margin margin)) (- ch margin margin))
(send dc set-alpha alpha) (send dc set-alpha alpha)
(send dc set-font normal-control-font)
(cond (cond
[horizontal? [horizontal?
@ -102,7 +103,7 @@
(let ([dc (get-dc)]) (let ([dc (get-dc)])
(cond (cond
[horizontal? [horizontal?
(let-values ([(w h _1 _2) (send dc get-text-extent label)]) (let-values ([(w h _1 _2) (send dc get-text-extent label normal-control-font)])
(do-w/h (+ w gap (send bitmap get-width)) (do-w/h (+ w gap (send bitmap get-width))
(max h (send bitmap get-height))))] (max h (send bitmap get-height))))]
[else [else