Version 14 of poor man's progressbar

Updated 2005-03-18 13:22:57

Brett Schwarz: So, you want a progressbar, but don't want to load an external package (ok, I am digging here :) ).

Well, you can get a basic progressbar by just re-using the scale widget. Here is an example:


 scale .sc \
    -orient horizontal \
    -sliderrelief flat \
    -sliderlength 0 \
    -troughcolor #AAAAAA \
    -showvalue 0 \
    -label 0

Notice the relief is flat. You could use another relief, but the results aren't as good. We set sliderlength to 0, so initially, nothing is shown. We will take advantage of the sliderlength to actually animate the progressbar.

Here is a proc that could be used to move the progressbar:


 proc setpb {value} {
    .sc configure \
        -sliderlength [expr {$value - 3}] \
        -label $value

    return
 }

the $value - 3 is just a fudge factor to make it look nicer when display (on Linux running 8.4.4). So, an example of the usage would be:


 proc go {} {
     for {set i 5} {$i <= 80} {incr i 5} {
        setpb $i
        update idletasks
        after 50
     }
 }

 button .go -text go -command go

You can also take advantage of a 'quirk' in the scale code, and use -activebackground along with -state option to change the color of the progressbar. So, it would look like this then:


 scale .sc \
    -orient horizontal \
    -sliderrelief flat \
    -sliderlength 0 \
    -troughcolor #AAAAAA \
    -showvalue 0 \
    -label 0 \
    -activebackground blue \
    -state active

There is no option to position the counter, so you are stuck with the default. Also, if the -orient is vertical, the progressbar goes from top to bottom.

There is one catch to this last incarnation -- if the mouse moves over the slider and then back again, then the color of the slider changes to the background color of the widget.

I also noticed on Windows that when you click on the slider, the -relief changes to raised...I think this is probably a bug???

And this is what it would look like:


http://bschwarz.com/scale_gauge.jpg


PT 14-Aug-2003: The relief changing bug was fixed in 8.4.4. For the other quirks you should play with the bindings. For instance:

  bind .sc <Enter> {break}
  bind .sc <Leave> {break}
  bind .sc <Motion> {break}
  bind .sc <1> {break}
  bind .sc <ButtonRelease-1> {break}

serves to make this pretty inactive and eliminates the colour change when the mouse passes over the widget. Better still is the use of the bindtags command:

  bindtags .sc [list .sc]

This will allow for custom bindings to this particular widget but ignores any default bindings from classes and such.


MGS [2003/08/19] - Here's a slightly more complete version, to allow for different -borderwith and -highlightthickness settings, and for dynamic resizing.

 # 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
   }

[ Category Example | Category GUI | Category Widget ]