The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

NAME - Tk::ProgressBar

DESCRIPTION

An Object-Oriented, sort-of animated Thermometer (Bells, Whistles) display for Perl/Tk, often useful for Wait Boxes (See Tk::WaitBox) and other cpu-intensive tasks.

SYNOPSIS

Basic Usage

To use, just create and configure (See sample code)

Configuration

Configuration may be done at creation or via the configure method. The following methods are configurable:

-foreground

Sets the color of the filled portion of the ProgressBar. Default 'blue'

-background

Sets the color of the empty (unfilled) portion of the ProgressBar. Default 'white'

-relief

Sets the relief of the filled portion of the ProgressBar. Default 'raised'

-backrelief

Sets the relief of the empty (unfilled) portion of the ProgressBar. Default 'sunken'

-height

Sets the width of the ProgressBar. No provision is currently made for ProgressBars that fill top-to-bottom, bottom-to-top, or anything other than left-to-right. Maybe someday. Default 20

-UpdateHook

Sets a routine to be called whenever the ProgressBar is updated. This routine will be called with parameters of (in order) current percentage, current value, and max value. (See -step, -max, and, again, sample code) Default none

-step

Sets the current value of the ProgressBar. The 'fullness' of the ProgressBar will be calculated as int(step/max*100) Default 0

-max

Sets the maximum range of the ProgressBar. Default 100

Sample Code
  •   #!/usr/local/bin/perl -w
    
      use Tk;
      use Tk::WaitBox;
      use Tk::ProgressBar;
    
      use strict;
    
      my($root) = MainWindow->new;
    
      my($utxtbase) = "Initializing";
      my($utxt) = $utxtbase;
    
      $root->Label(-textvariable => \$utxt)
              ->pack(-expand => 1, -fill => 'x');
    
      my($t) = $root->ProgressBar->pack;
    
      $t->configure(-UpdateHook => \&Hook,
                    -relief => 'sunken',
                    -backrelief => 'raised');
    
      $root->update;
      $root->deiconify;
    
      my($i,@a);
      my($tot) = 2000;
    
      $t->configure(-step => 0, -max => $tot);
    
      $utxtbase = "Filling";
    
      srand(time|$$);
    
      for ($i = 0; $i <= $tot; $i++) {
          if (($i % 10) == 0) {
              $t->configure(-step => $i);
          }
          @a[$i] = int(rand(10001));
      }
    
      $i = 0;
      my($max) = int(2 * $tot * log($tot));
      print "Maybe $max steps?\n";
    
      $t->configure(-max => $max);
    
      $max = $max /1000;
      $utxtbase = "Sorting";
    
      foreach (sort {
          if (($i % $max) == 0) {
              $t->configure(-step => $i);
          }
          $i++;
          $a <=> $b
      } @a) {
      }
      print "$i sort steps for $tot\n";
    
      sub Hook {
          my($percent) = shift;
          $utxt = "$utxtbase $percent%";
    
          ## Alternatively,
          #     my($percent, $step, $max) = @_;
          #     $utxt = "$utxtbase $percent% step $step of $max";
      }

Author

Brent B. Powers, (B2Pi) powers@ml.com

This code may be distributed under the same conditions as perl itself.