WJG (17/Feb/06) Yet another progress bar offering. This uses simple coloured frame as the indicator which is configured using the place -relwidth option. Minimal options, cut, paste and play..
#--------------- # progress.tcl #--------------- # Created by William J Giddings, 2006 # # Simple progress bar with minimal options # # Notes: Value sent to bar must be within range 0.0 - 1.0 # #--------------- # Credits: https://wiki.tcl-lang.org/1146 #--------------- #--------------- # simple progress bar #--------------- proc progress {w args} { eval frame $w $args ;# create the "base" thing frame $w.bar -background blue -relief raised -borderwidth 6 place $w.bar -relwidth .3 -relheight 1.0 rename $w _$w ;# keep the original widget command # Here comes the overloaded widget proc: proc $w {args} { set self [lindex [info level 0] 0] ;# get name I was called with foreach {opt val} $args { switch -- $opt { -val {eval "place $self.bar -relwidth $val"} default {uplevel 1 _$self $args} } } } return $w ;# like the original "text" command } #--------------- # Some demo stuff #--------------- pack [frame .fr1 ] -fill x foreach {i j} {1 0.25 2 0.50 3 0.75 } { pack [button .fr1.b$i -text $j -command ".pg -val $j" -width 5] -side left } pack [progress .pg -height 16 -width 120 -borderwidth 2 -relief sunken]