A progressbar done with a scale widget.
FROM: http://wiki.tcl.tk/9621
(imaged on 2009 mar 19)
(see some improvements/changes discussed on that page)


 # progress.tcl --
 # A simple progress meter using a Tk scale widget.

 # ======================================================================

 proc progress {W args} {

   array set map [list \
     -bd -borderwidth \
     -bg -background \
   ]

   array set arg [list \
     -activebackground blue \
     -borderwidth 1 \
     -from 0 \
     -to 100 \
     -orient horizontal \
     -sliderrelief flat \
     -sliderlength 0 \
     -troughcolor #AAAAAA \
     -showvalue 0 \
     -label 0 \
     -state active \
   ]

   foreach {option value} $args {
     if { [info exists map($option)] } { set option $map($option) }
     set arg($option) $value
   }

   eval [linsert [array get arg] 0 scale $W]

   bind $W <Enter>  {break}
   bind $W <Leave>  {break}
   bind $W <Motion> {break}
   bind $W <1>      {break}
   bind $W <ButtonRelease-1> {break}

   bind $W <Configure> [list [namespace current]::progress:redraw %W]

   return $W

 }

 # ======================================================================

 proc progress:redraw {W} {
   set value [$W cget -label]
   set bd    [$W cget -bd]
   set ht    [$W cget -highlightthickness]
   set from  [$W cget -from]
   set to    [$W cget -to]
   set w [winfo width $W]
   set tw [expr {$w - (4 * $bd) - (2 * $ht)}]
   set range [expr {$to - $from}]
   set pc [expr {($value - $from) * 1.0 / $range}]
   set sl [expr {round($pc * $tw)}]
   $W configure -sliderlength $sl
   return
 }

 # ======================================================================

 proc progress:set {W value} {
   $W configure -label $value
   progress:redraw $W
   return
 }

 # ======================================================================

 proc go {W value} {
   progress:set $W $value
   incr value
   if { $value <= 75 } {
     after 50 [list go $W $value]
   }
 }

   if { [info exists argv0] && [string equal [info script] $argv0] } {
     progress .sc

     button .go -text go -default active \
       -command [list [namespace current]::go .sc 0]

     pack .sc -side top    -expand 1 -fill both
     pack .go -side bottom -expand 0 -fill none -anchor se
   }