Version 2 of progress -Progress Bar Widget with Minimal Options

Updated 2006-02-17 15:30:11

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: http://wiki.tcl.tk/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]