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

tweaks to fix multi-line labels (via newlines) in button%

Browse Source
This commit is contained in:
Robby Findler 2013-09-13 14:09:15 -05:00
parent 23f77a6054
commit 54f283bf86
3 changed files with 7 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/button.rkt
View File

@ -53,7 +53,8 @@
(when button-type
(tellv cocoa setButtonType: #:type _int button-type))
(unless button-type
(tellv cocoa setBezelStyle: #:type _int (if (not (string? label))
(tellv cocoa setBezelStyle: #:type _int (if (or (not (string? label))
(regexp-match? #rx"\n" label))
NSRegularSquareBezelStyle
NSRoundedBezelStyle)))
(cond

2
pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/button.rkt
View File

@ -55,7 +55,7 @@
[(right) BS_RIGHT]
[(top) BS_TOP]
[(bottom) BS_BOTTOM])
0))
BS_MULTILINE))
0 0 0 0
(send parent get-content-hwnd)
#f

5
pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/window.rkt
View File

@ -383,7 +383,10 @@
(values (combine-w w1 w2) (combine-h h1 h2)
(combine-h d1 d1) (combine-h a1 a2)))]
[else
(send measure-dc get-text-extent label #f #t)]))]
(define strs (regexp-split #rx"\n" label))
(for/fold ([w 0][h 0][d 0] [a 0]) ([str (in-list strs)])
(define-values (tw th d a) (send measure-dc get-text-extent label #f #t))
(values (max w tw) (+ h th) 0 0))]))]
[(->int) (lambda (v) (inexact->exact (ceiling v)))])
(resize (->int (* scale-h (max (+ w dw) min-w)))
(->int (* scale-w (max (+ h dh) min-h)))))))