ulis, 2005-06-28. Un label dont le texte prend toute la place.
Pourquoi
Au départ, c'est un des 3 problèmes du Contest Tcl de 2002. C'est aussi un widget qui peut être utile. Et comme la solution de Brent Welch (le seul lauréat et vainqueur) ne marche pas sous mon Windows Server 2003...
Comment
Toujours avec un canvas. Et en calculant la hauteur réelle du texte en simulant la justification.
Le widget
# contest package require Tk proc contest {w family text} \ { # create widget set font [font create -family $family] canvas $w $w create text 0 0 -anchor center \ -tags text -justify center \ -text $text -font $font # bind resizing bind $w <Configure> {resize %W} } proc resize {w} \ { # on resizing set width [winfo width .] set height [winfo height .] set font [$w itemcget text -font] # get actual text height set th [height $w $width $font] if {$th != $height} \ { set size [font actual $font -size] if {$th < $height} \ { # growing while {$th < $height + 2} \ { # increment font size font config $font -size [incr size] # compute actual height set th [height $w $width $font] } if {$th != $height} \ { # a bit too long font config $font -size [incr size -1] set th [height $w $width $font] } } \ else \ { # shrinking while {$th > $height + 2} \ { # decrement font size font config $font -size [incr size -1] # compute actual height set th [height $w $width $font] } } } # set justifyied text & adjusted font $w itemconfig text -font $font \ -text [join [lines $w $width $font] \n] # center to avoid too large border center $w } proc center {w} \ { # center text set width [winfo width $w] set height [winfo height $w] set xc [expr {$width / 2}] set yc [expr {$height / 2}] $w coord text $xc $yc } proc height {w width font} \ { # compute text height set lh [font metrics $font -linespace] set count [llength [lines $w $width $font]] return [expr {$lh * $count}] } proc lines {w width font} \ { # justify text to know how many lines set text [string map {\n {}} [$w itemcget text -text]] set lines [list] set line "" while {$text != ""} \ { set ch [string index $text 0] if {[font measure $font "$line$ch"] > $width} \ { # too large set n [string last " " $line] if {$n > -1} \ { set text "[string range $line [expr {$n + 1}] end]$text" set line [string range $line 0 $n] } lappend lines $line set line "" } \ else \ { # not enough set line "$line$ch" set text [string range $text 1 end] } } # add last line if {$line != ""} { lappend lines $line } # return list of lines return $lines } # try contest .c Arial "Tcl2002 programming contest: problem 2" pack .c -fill both -expand 1 .c config -width 150 -height 150
Voir aussi
Catégorie Exemple | Catégorie Widget