A crude example:

#!/usr/bin/perl
use warnings;
use strict;
use Tk;

my $w=20;
my $x=0;
my $y=0;

my %colors = (
   0 => ['black','yellow'], 
   1 => ['yellow','black'], 
   2 => ['white','green'],    
   3 => ['green','white'], 
   4 => ['grey','red'], 
   5 => ['red','grey'], 
   6 => ['blue','white'], 
   7 => ['white','blue'], 
   8 => ['orange','grey45'], 
   9 => ['grey45','orange'], 
);

my %bardata = (
   0 => rand 200,
   1 => rand 200,
   2 => rand 200,
   3 => rand 200,
   4 => rand 200,
   5 => rand 200,
   6 => rand 200,
   7 => rand 200,
   8 => rand 200,
   9 => rand 200,
);

my %bars;

my $mw=tkinit;
my $c = $mw->Canvas->pack;

for (0..9) {
  $bars{$_} = $c->createRectangle($x,$y,$x+20,$bardata{$_},
             -fill=> ${$colors{$_}}[0],
          );

my $text = $c->createText($x+10,$y+10,
           -anchor=>'center',
       -fill => ${$colors{$_}}[1],
       -text => $_
          );
      
      $x+=20;
}

$mw->repeat(200, sub{ &update });
 
MainLoop;
##########################################################
sub update{

$x=0;
$y=0;

 %bardata = (
   0 => rand 200,
   1 => rand 200,
   2 => rand 200,
   3 => rand 200,
   4 => rand 200,
   5 => rand 200,
   6 => rand 200,
   7 => rand 200,
   8 => rand 200,
   9 => rand 200,
);


  for (0..9) {

  $c->delete( $bars{$_}  );

  $bars{$_} = $c->createRectangle($x,$y,$x+20,$bardata{$_},
             -fill=> ${$colors{$_}}[0],
          );

  my $text = $c->createText($x+10,$y+10,
           -anchor=>'center',
       -fill => ${$colors{$_}}[1],
       -text => $_
          );
      
      $x+=20;
  }
}
[download]

Here is an example that does what I think you want. It is a hack that swaps colors. The problem with it, is once all colors are swapped to red, it is tricky to restore original bar colors. I used red1, red2, red3 to differentiate and restore. It would seem that you could itemconfigure the progressbar for -colors, to restore original bar colors, but it dosn't seem to work.

I hope it stimulates a solution for you.

#!/usr/bin/perl
use strict;
use Tk;
use Tk::ProgressBar;

our $percent_done = 0;
our $stopped = 0;

my $mw = MainWindow->new(qw/-title Working/);

my $progress = $mw->ProgressBar(
  -width => 20,
  -height => 400,
  -from => 0,
  -to => 100,
  -blocks => 50,
  -colors => [0, 'blue',30,'yellow',70,'orange'],
  -variable => \$percent_done
)->pack;

my $buttonF = $mw->Frame->pack;

my $startB = $buttonF->Button(
  -text => 'start',
  -command => sub {
  $stopped = 0;
  $percent_done = 0;

# hack to restore colors, I use different red shades
# but you could store the information in a hash somehow
# to get back to the original colors
  swapColor($progress, "red1", "blue");
  swapColor($progress, "red2", "yellow");
  swapColor($progress, "red3", "orange");

foreach my $x (1 .. 100) {
 select(undef,undef,undef,.05);
   if ($stopped) {
    swapColor($progress, "blue", "red1");
    swapColor($progress, "yellow", "red2");
    swapColor($progress, "orange", "red3");
  return;
  }
 $percent_done = $x;
 $progress->update;
 }
})->pack(-side => 'left');


my $stopB = $buttonF->Button(
  -text => "stop",
  -command => sub { $stopped = 1; }
 )->pack(-side => 'left');

MainLoop;

sub swapColor {
my ($pb, $oldColor, $newColor) = @_;
  foreach my $tag ($pb->find("all")) {
     print $tag,'->',$pb->itemcget($tag, "-fill"),"\n";
     if ($pb->itemcget($tag, "-fill") eq $oldColor) {
       $pb->itemconfigure($tag, -fill => $newColor);
    }
  }
print "\n\n";
}
[download]

I can see 2 potential problems here: -colors and -variable.

-colors

It looks like you've read the documentation to get 0, 50 and 80 (which is good) but not fully understood it (less good). The doco is not very clear about this option so that's not overly surprising.

What you actually have says:

• When the dereferenced value of the scalar reference supplied to the -variable option (the progress value) is 0, start showing the progress bar in green. Keep showing it as green until the progress value reaches 50.
• When the progress value reaches 50, stop showing the progress bar in green from this point forward and instead show it in green. Keep showing it as green until the progress value reaches 80.
• When the progress value reaches 80, stop showing the progress bar in green from this point forward and instead show it in green. Keep showing it as green until the progress value reaches 100 (the value supplied to the -to option).

So what you really want here is:

    -colors => [ 0, 'green' ],
[download]

-variable

This may be perfectly fine but it leaps out at me as a source of potential error. Please check the following:

• You declared something like: my %T_testers = ($tst => { ProgS => 0, ... })
• %T_testers is visible to both my $Prb = $TBL_frame->ProgressBar(...); and the routine whose progress you're measuring (the progress routine).
• You are setting $T_testers{$tst}->{"ProgS"} to zero before the progress routine starts.
• You are incrementing $T_testers{$tst}->{"ProgS"} as the progress routine proceeds such that it reaches 100 when the progress routine finishes.

Perl/Tk is one of my favourite toys so I don't mind helping with this. However, if you require further assistance, please do the following:

• Ensure you have use strict; and use warnings; in your code.
• Provide an actual description of what you want your GUI to do with respect to this progress bar.
• Provide a full description of what, if anything, went wrong. I'm sorry but "... it didnt work ..." [sic] is completely unacceptable.
• Show enough of the code so that all of the points indicated above (declarations, assignments, increments, etc.) can be seen.

If you run this script, and hit Stop, the bar will turn red only after you just SLIGHTLY resize the window. The same occurs after a second START, the bar returns to original colors after a slight resize of the window.

I tried update, packPropagate, idletasks, etc. to stimulate the update, but no luck.

Does anyone know how to trigger the progressbar's deep update without a window resize? I suppose as a hack, the Start and Stop buttons could include some code to do a 1-pixel resize of the $mw. :-)

#!/usr/bin/perl
use strict;
use Tk;
use Tk::ProgressBar;

our $percent_done = 0;
our $stopped = 0;

my $mw = new MainWindow;

$mw->geometry('200x100+100+100');

my $progress = $mw->ProgressBar(
  -width => 40,
  -height => 20,
  -from => 0,
  -to => 100,
  -blocks => 50,
  -colors => [0, 'blue',30,'yellow',70,'orange'],
  -variable => \$percent_done
)->pack(-expand=>1, -fill=>'x');

my $buttonF = $mw->Frame->pack;

my $timer;

my $startB = $buttonF->Button(
  -text => 'start',
  -command => sub {
        $stopped = 0;
        $percent_done = 0;
      
      #restore original colors 
$progress->configure('-colors',[0, 'blue',30,'yellow',70,'orange'] );
               
               $mw->idletasks; # these commands
               $mw->update;    # don't seem to work
                               #but a window resize does
        $timer = $mw->repeat(50,
          sub{
              $percent_done++;
              $progress->update;
           
               if ($stopped) {
      #set red colors
     $progress->configure('-colors', [0, 'red',30,'red',70,'red'] );
               
               $mw->idletasks; # these commands
               $mw->update;    # don't seem to work
                               #but a window resize does
               
               
                $timer->cancel;
               }
             })        
     }
)->pack(-side => 'left');

my $stopB = $buttonF->Button(
  -text => "stop",
  -command => sub { $stopped = 1; }
 )->pack(-side => 'left');

MainLoop;
[download]

Does anyone know how to trigger the progressbar's deep update without a window resize?

Short answer: yes :-)

Longer answer:

I now think I see what Ohad's problem is. I originally thought the progress bar wasn't changing as the variable was being updated.

With reference to your earlier "... you might want to build your own on a Tk::Canvas.", Tk::ProgressBar is already a derived widget based on Tk::Canvas.

The -colors option is configured as PASSIVE. It's not intended to be changed after creation of the widget. However, it can be done by accessing the private method _layoutRequest().

WARNING! Accessing private methods is bad!
The code maintainer may change it, or even remove it, at any time.
Use the following code entirely at your own risk!

OK, that's my arse covered :-) Here's the solution:

#!perl

use strict;
use warnings;

use Tk;
use Tk::Button;
use Tk::ProgressBar;

my $mw = MainWindow->new();

my $progress;
my $toggle = 0;
my @colours = (
    [ 0 => q{#ff0000}, 30 => q{#00ff00}, 60 => q{#0000ff} ],
    [ 0 => q{#ffff00}, 30 => q{#00ffff}, 60 => q{#ff00ff} ],
);

my $pb = $mw->ProgressBar(
    -width => 20,
    -length => 200,
    -colors => $colours[$toggle],
    -variable => \$progress,
)->pack();

$mw->Button(-text => q{Jump WITH Change},
    -command => sub {
        $progress ||= 0;
        $progress = ($progress + 10) % 110;
        $toggle ^= 1;
        $pb->configure(-colors => $colours[$toggle]);
        Tk::ProgressBar::_layoutRequest($pb, 1);
    }
)->pack();

$mw->Button(-text => q{Jump NO Change},
    -command => sub {
        $progress ||= 0;
        $progress = ($progress + 10) % 110;
        $toggle ^= 1;
        $pb->configure(-colors => $colours[$toggle]);
    }
)->pack();

$mw->Button(-text => q{Exit}, -command => sub { exit })->pack();

MainLoop;
[download]

Tested successfully under Windows and Cygwin.

-- Ken

Thanks for this excellent lesson! I was trying to go the route of eventGenerate('configure'), to trigger the update, but was running into errors.

 
Tk::ProgressBar::_layoutRequest($pb, 1);
[download]

---

I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku ................... flash japh

Thanks!!

For your time and effort, the layoutRequest works!!