tweaks to fix multi-line labels (via newlines) in button%
This commit is contained in:
parent
23f77a6054
commit
54f283bf86
|
@ -53,7 +53,8 @@
|
||||||
(when button-type
|
(when button-type
|
||||||
(tellv cocoa setButtonType: #:type _int button-type))
|
(tellv cocoa setButtonType: #:type _int button-type))
|
||||||
(unless 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
|
NSRegularSquareBezelStyle
|
||||||
NSRoundedBezelStyle)))
|
NSRoundedBezelStyle)))
|
||||||
(cond
|
(cond
|
||||||
|
|
|
@ -55,7 +55,7 @@
|
||||||
[(right) BS_RIGHT]
|
[(right) BS_RIGHT]
|
||||||
[(top) BS_TOP]
|
[(top) BS_TOP]
|
||||||
[(bottom) BS_BOTTOM])
|
[(bottom) BS_BOTTOM])
|
||||||
0))
|
BS_MULTILINE))
|
||||||
0 0 0 0
|
0 0 0 0
|
||||||
(send parent get-content-hwnd)
|
(send parent get-content-hwnd)
|
||||||
#f
|
#f
|
||||||
|
|
|
@ -383,7 +383,10 @@
|
||||||
(values (combine-w w1 w2) (combine-h h1 h2)
|
(values (combine-w w1 w2) (combine-h h1 h2)
|
||||||
(combine-h d1 d1) (combine-h a1 a2)))]
|
(combine-h d1 d1) (combine-h a1 a2)))]
|
||||||
[else
|
[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)))])
|
[(->int) (lambda (v) (inexact->exact (ceiling v)))])
|
||||||
(resize (->int (* scale-h (max (+ w dw) min-w)))
|
(resize (->int (* scale-h (max (+ w dw) min-w)))
|
||||||
(->int (* scale-w (max (+ h dh) min-h)))))))
|
(->int (* scale-w (max (+ h dh) min-h)))))))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user