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)
(let ([dc (get-dc)])
(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)
(min-client-width (inexact->exact (floor tw)))))))
(define/override (on-paint)
(let ([dc (get-dc)])
(send dc set-font normal-control-font)
(let-values ([(cw ch) (get-client-size)]
[(tw th _1 _2) (send dc get-text-extent str)])
(send dc draw-text str 0 (/ (- ch th) 2)))))

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

@ -69,6 +69,7 @@
(- cw margin margin)
(- ch margin margin))
(send dc set-alpha alpha)
(send dc set-font normal-control-font)
(cond
[horizontal?
@ -102,7 +103,7 @@
(let ([dc (get-dc)])
(cond
[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))
(max h (send bitmap get-height))))]
[else