Tk Source Code

Artifact 4da6b49160e97424e58eb9be2451f4e7fb03febb981ed9f4647bc5037f707117:

Attachment "size-const-demo2.tcl" to ticket [23f52946] added by emiliano 2026-04-20 14:00:18.

---

package require Tk

proc animate {a} {
    global aid
    .lf.l configure -textangle [expr {$a}]
    set aid [after 100 [list animate [expr {fmod($a+5, 360)}]]]
}

font create oldc -family Courier -size 16
font create newc -family {Courier New} -size 16
frame .lf -width 500 -height 300 -bg white
label .lf.l \
    -text "Hello\nworld" \
    -anchor center \
    -font oldc \
    -background yellow \
    -relief raised
place .lf.l -relx 0.5 -rely 0.5 -anchor center

frame .cf
checkbutton .cf.cw -variable w -text "set width" -command {
    .lf.l configure -width [expr {$w * $wval}]
}
spinbox .cf.sw -textvariable wval -from 2 -to 50 -command {
    .lf.l configure -width [expr {$w * $wval}]
}
checkbutton .cf.ch -variable h -text "set height" -command {
    .lf.l configure -height [expr {$h * $hval}]
}
spinbox .cf.sh -textvariable hval -from 1 -to 5 -command {
    .lf.l configure -height [expr {$h * $hval}]
}
checkbutton .cf.ani -variable animate -text Animate -command {
    if {$animate} {
	animate 5
    } else {
	after cancel $aid
    }
}
radiobutton .cf.ro -text "Use {Courier}" -variable font -value oldc -command {
	.lf.l configure -font $font
}
radiobutton .cf.rn -text "Use {Courier New}" -variable font -value newc -command {
	.lf.l configure -font $font
}
grid .cf.cw .cf.sw -sticky w
grid .cf.ch .cf.sh -sticky w
grid .cf.ro .cf.rn -sticky w
grid .cf.ani -sticky w
pack .lf .cf -side left -fill y
set animate 0
set wval 10
set hval 2
set font oldc