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

win32: fix screen-glyph reporting for label mode

Browse Source 
because XP doesn't substitute fonts in control labels

original commit: 6defe0ea09368b38f6015cd27caed599fdcf875f
This commit is contained in:
Matthew Flatt 2011-01-11 19:16:39 -07:00
parent bc097d0606
commit 53db50dc93
1 changed files with 3 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/mred/private/wx/win32/button.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base #lang racket/base
(require racket/class (require racket/class
racket/draw racket/draw
racket/draw/private/xp
ffi/unsafe ffi/unsafe
"../../syntax.rkt" "../../syntax.rkt"
"../../lock.rkt" "../../lock.rkt"
@ -19,10 +20,6 @@
(define BM_SETSTYLE #x00F4) (define BM_SETSTYLE #x00F4)
(define-kernel32 GetVersion (_wfun -> _DWORD))
(define xp? (= 5 (bitwise-and #xFF (GetVersion))))
(define base-button% (define base-button%
(class item% (class item%
(inherit set-control-font auto-size get-hwnd (inherit set-control-font auto-size get-hwnd
@ -136,6 +133,8 @@
(auto-size font label 60 20 12 0 #:scale-w 1.1 #:scale-h 1.1)])) (auto-size font label 60 20 12 0 #:scale-w 1.1 #:scale-h 1.1)]))
(auto-size-button font label) (auto-size-button font label)
;; XP doesn't show both bitmap and string labels,
;; so we synthesize a bitmap label when we have both
(define xp-label-bitmap (and xp? orientation (car label))) (define xp-label-bitmap (and xp? orientation (car label)))
(define xp-label-string (and xp? orientation (string->immutable-string (cadr label)))) (define xp-label-string (and xp? orientation (string->immutable-string (cadr label))))
(define xp-label-font (and xp? orientation font)) (define xp-label-font (and xp? orientation font))