[schlenk], 19. July 2005: Answering a question on self-tcl.de [http://www.self-tcl.de/forum/viewtopic.php?p=2004] i came up with this little demo.
It shows how to dynamically resize a label with some text, when the window is resized:
======
package require Tk
package require math::interpolate
proc createInterpolationTable {win font text} {
set max [winfo vrootwidth $win]
set oldsize [font configure $font -size]
set xval [list]
set yval [list]
set x 0
set size 2
while {$x < $max} {
font configure $font -size $size
set x [font measure $font $text]
lappend xval $x
lappend yval $size
incr size 4
}
font configure $font -size $oldsize
return [list $xval $yval]
}
proc adjustFont {font width ipt} {
set newSize [lindex [math::interpolate::neville [lindex $ipt 0] [lindex $ipt 1] $width] 0]
font configure $font -size [expr {int($newSize)}]
}
proc configureBinding {font ipt win width heigth} {
bind $win <Configure> {}
adjustFont $font $width $ipt
after idle [list bind $win <Configure> [list configureBinding title $ipt %W %w %h]]
}
font create title -family Verdana -size 10
toplevel .test
set txt "Some Title"
set ipt [createInterpolationTable .test title $txt]
label .test.l -text $txt -font title
pack .test.l -expand 1 -fill both
wm geometry .test 400x300+0+0
bind .test.l <Configure> [list configureBinding title $ipt %W %w %h]
======
[MHo] - 2008-02-27: just tested on windows. After starting the program, I had no chance to klick anything: the window constantly flickers. Had to press Alt+F4 to cancel. Looks like the ''Configure''-event is constantly fired...
[fr] - 2020-01-31: added first and last line in "proc configureBinding", initial size by "wm geometry .."
[DDG] - 2020-02-01: fix window name in proc configureBinding and added snit widget below
----
[DDG] - 2020-02-01: Here is a [snit]::widget dlabel where dlabel stands for dynamic label:
======
package require Tk
package require snit
package require math::interpolate
snit::widget dlabel {
component label
option -text "Default"
delegate method * to label
delegate option * to label
option -font ""
constructor {args} {
install label using ttk::label $win.lbl {*}$args
$self configurelist $args
if {$options(-font) eq ""} {
set mfont [font create {*}[font configure TkDefaultFont]]
$label configure -font $mfont
set options(-font) $mfont
}
set ipt [$self createInterpolationTable $win $options(-font) [$self cget -text]]
pack $label -side top -fill both -expand yes -padx 10 -pady 10
bind $label <Configure> [mymethod configureBinding $ipt %W %w %h]
}
method createInterpolationTable {mwin font text} {
set max [winfo vrootwidth $mwin]
set oldsize [font configure $font -size]
set xval [list]
set yval [list]
set x 0
set size 2
while {$x < $max} {
font configure $font -size $size
set x [font measure $font $text]
lappend xval $x
lappend yval $size
incr size 4
}
font configure $font -size $oldsize
return [list $xval $yval]
}
method adjustFont {font width ipt} {
set newSize [lindex [math::interpolate::neville [lindex $ipt 0] [lindex $ipt 1] $width] 0]
font configure $font -size [expr {int($newSize)-2}] ; #added -2 to make it slightly smaller
}
method configureBinding {ipt mwin width heigth} {
set font [$self cget -font]
bind $mwin <Configure> {}
$self adjustFont $font $width $ipt
after idle [list bind $mwin <Configure> [mymethod configureBinding $ipt %W %w %h]]
}
}
# demo
proc demo {} {
font create title -family Verdana -size 10
toplevel .test
set txt " Some Title "
dlabel .test.l -text $txt -font title
pack .test.l -expand 1 -fill both
wm geometry .test 400x300+0+0
}
======
[DDG] - 2020-02-01: Here comes a simpler solution based on `font metrics` and `font measure` commands which does not require the `math::interpolate` package.
======
package require snit
snit::widget dlabel2 {
component label
option -text "Default"
delegate method * to label
delegate option * to label
option -font ""
constructor {args} {
install label using ttk::label $win.lbl {*}$args
$self configurelist $args
if {$options(-font) eq ""} {
set mfont [font create {*}[font configure TkDefaultFont]]
$label configure -font $mfont
set options(-font) $mfont
}
pack $label -side top -fill both -expand yes -padx 10 -pady 10
bind $label <Configure> [mymethod configureBinding %W %w %h]
}
method adjustFont {width height} {
set cw [font measure $options(-font) $options(-text)]
set ch [font metrics $options(-font)]
set size [font configure $options(-font) -size]
# shrink
set shrink false
while {true} {
set cw [font measure $options(-font) $options(-text)]
set ch [font metrics $options(-font)]
set size [font configure $options(-font) -size]
if {$cw < $width && $ch < $height} {
break
}
incr size -2
font configure $options(-font) -size $size
set shrink true
}
# grow
while {!$shrink} {
set cw [font measure $options(-font) $options(-text)]
set ch [font metrics $options(-font)]
set size [font configure $options(-font) -size]
if {$cw > $width || $ch > $height} {
incr size -2 ;#set back
font configure $options(-font) -size $size
break
}
incr size 2
font configure $options(-font) -size $size
}
}
method configureBinding {mwin width height} {
bind $mwin <Configure> {}
$self adjustFont $width $height
after idle [list bind $mwin <Configure> [mymethod configureBinding %W %w %h]]
}
}
proc demo2 {} {
# just testing
font create title -family Verdana -size 10
toplevel .test
set txt " Some Title "
dlabel2 .test.l -text $txt -font title
pack .test.l -expand 1 -fill both
wm geometry .test 400x300+0+0
}
======
See also [font]
----
'''[RJT] - 2022-12-08 23:25:23'''
<>
<<categories>> Example | Characters | GUI | Snit Widgets