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

win32: fix font used to size controls

Browse Source
This commit is contained in:
Matthew Flatt 2010-12-02 07:04:38 -07:00
parent 1032eb4a59
commit b0a746c701
1 changed files with 13 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -322,7 +322,7 @@
[dc (make-object bitmap-dc% bm)]) [dc (make-object bitmap-dc% bm)])
(set! measure-dc dc))) (set! measure-dc dc)))
(send measure-dc set-font (or font (send measure-dc set-font (or font
(make-object font% 8 'system))) (get-default-control-font)))
(let-values ([(w h d a) (let loop ([label label]) (let-values ([(w h d a) (let loop ([label label])
(cond (cond
[(null? label) (values 0 0 0 0)] [(null? label) (values 0 0 0 0)]
@ -689,6 +689,18 @@
;; ---------------------------------------- ;; ----------------------------------------
(define default-control-font #f)
(define (get-default-control-font)
(unless default-control-font
(set! default-control-font
(make-object font%
(get-theme-font-size)
(get-theme-font-face)
'system
'normal 'normal #f 'default
#t)))
default-control-font)
(define (queue-window-event win thunk) (define (queue-window-event win thunk)
(queue-event (send win get-eventspace) thunk)) (queue-event (send win get-eventspace) thunk))