Posted to tcl by kbk at Sun Jan 25 01:17:37 GMT 2009view raw
- package require Tk
- set fontlist "8 5 10 9 6 11 10 6 13 12 7 15 14 8 17 16 10 20 18 11 22 24 14 30 30 18 37 36 22 45"
- foreach {size width height} $fontlist {
- font create font$size -family {Courier New} -size [expr {-$height}]
- while {[font measure font$size M] > $width} {
- incr height -1
- font configure font$size -size [expr {-$height}]
- }
- }
- grid [canvas .c -width 300 -height 30]
- proc paintText {canvas x y string font width height} {
- set xx $x
- set yy $y
- foreach c [split $string {}] {
- if {$c eq "\n"} {
- incr yy $height
- set xx $x
- } else {
- $canvas create text $xx $yy -text $c -anchor nw -font $font
- incr xx $width
- }
- }
- }
- paintText .c 10 5 Testing font16 10 20