Value Display add-on for Tk::ProgressBar.pm

--- ProgressBar_804.027_500.pm	2007-05-11 12:12:42.953311000 +0200
+++ ./ProgressBar.pm	2007-05-11 12:44:26.256274000 +0200
@@ -45,6 +45,12 @@
 		  => [SELF => 'highlightThickness','HighlightThickness',0],
 	-troughcolor
 		  => [PASSIVE => 'troughColor', 'Background', 'grey55'],
+	# Add-On for Value-Display (percentage as text)
+ 	-showvalue      => [PASSIVE => undef, undef, 0],
+ 	-valueformat    => [PASSIVE => undef, undef, '%s%%'],
+ 	-valuecolor     => [PASSIVE => undef, undef, 'white'],
+ 	-font           => [PASSIVE => 'font', 'Font', undef],
+	-valuecolors    => [PASSIVE => undef, undef, undef],
     );
     _layoutRequest($c,1);
     $c->OnDestroy(['Destroyed' => $c]);
@@ -84,6 +90,8 @@
     my $x = abs(int($c->{Configure}{'-padx'})) + $bw;
     my $y = abs(int($c->{Configure}{'-pady'})) + $bw;
     my $value = $c->value;
+	my $realvalue = $value;
+
     my $from = $c->{Configure}{'-from'};
     my $to   = $c->{Configure}{'-to'};
     my $horz = $c->{Configure}{'-anchor'} =~ /[ew]/i ? 1 : 0;
@@ -144,6 +152,25 @@
 		-width => 0,
 		-outline => undef);
 
+	# Add-On for Value-Display (percentage as text)
+	if ($c->cget('-showvalue')) {
+		my $text = sprintf($c->cget('-valueformat'), $value);
+		my @font; @font = (-font => $c->cget('-font') ) if defined $c->cget('-font');
+		my ($xpos, $ypos) = ($x+$w/2, $y+$h/2);
+		$c->createText($xpos, $ypos,
+			-text => $text,
+			-tags => 'percentage',
+			-fill => $c->cget('-valuecolor'),
+			@font,
+		);
+		$c->createText(++$xpos, ++$ypos,
+			-text => $text,
+			-tags => 'percentage_tr',
+			-fill => $c->{Configure}{'-troughcolor'},
+			@font,
+		);
+	}
+
 	my($x0,$y0,$x1,$y1);
 
 	if($horz) {
@@ -170,6 +197,8 @@
 	my $color = $c->cget('-foreground');
 	my $pos   = 0;
 	my $val   = $minv;
+	# Add-On for Value-Display (percentage-related color)
+	my $valuecolor = $c->cget('-valuecolor');
 
 	while($val < $maxv) {
 	    my($bw,$nval);
@@ -277,6 +306,38 @@
 	$c->raise($cover);
 	$c->coords($cover,$x0,$y0,$x1,$y1);
     }
+
+    # Add-On for Value-Display (percentage as text)
+    if ($c->cget('-showvalue')) {
+        my ($min, $max);
+        if ($c->{Configure}{'-to'} > $c->{Configure}{'-from'}) {
+            $min = $c->{Configure}{'-from'};
+            $max = $c->{Configure}{'-to'};
+        }
+        else {
+            $min = $c->{Configure}{'-to'};
+            $max = $c->{Configure}{'-from'};
+        }
+        $realvalue = $min if $realvalue < $min;
+        $realvalue = $max if $realvalue > $max;
+
+        # Support for relative Value Colors
+        my (%valuecolors, $valuecolors, $valuecolor, $pos);
+        $valuecolors = $c->{Configure}{'-valuecolors'} || [0, $c->cget('-valuecolor')];
+        %valuecolors = @$valuecolors;
+        foreach $pos ( sort keys %valuecolors) {
+            $valuecolor = $valuecolors{$pos} if $realvalue >= $pos;
+        }
+        $c->itemconfigure('percentage', -fill => $valuecolor);
+        my $text = sprintf($c->cget('-valueformat'), $realvalue);
+        $c->dchars('percentage_tr', 0, 'end');
+        $c->insert('percentage_tr', 0, $text); 
+        $c->raise('percentage_tr');
+        #---------------------------------
+        $c->dchars('percentage', 0, 'end');
+        $c->insert('percentage', 0, $text); 
+        $c->raise('percentage');
+    }
 }
 
 sub value {
@@ -342,6 +403,11 @@
 	-blocks => 10,
 	-colors => [0, 'green', 50, 'yellow' , 80, 'red'],
 	-variable => \$percent_done
+	# New Options
+	-showvalue => '1',
+	-valuecolor => 'black',
+	-font => '9x15',
+	-valueformat => '<%s %%>',
     );
 
     $progress->value($position);
@@ -468,6 +534,38 @@
 bars this is the ProgressBars height.  The default width is derived
 from the values of C<-borderwidth> and C<-pady> and C<-highlightthickness>.
 
+
+=item B<-showvalue>
+
+This enables the current (percentage) value to be displayed.
+
+
+=item B<-valueformat>
+
+Specifies the desired text mask for the current value value
+to be displayed. Defaults to '%s%%'
+
+
+=item B<-valuecolor>
+
+Specifies the desired text color for the  current (percentage)
+value to be displayed.
+
+
+=item B<-valuecolors>
+
+Controls the colors to be used for value visualization of the progress bar.
+The colors should be supplied as a reference to an array containing pairs
+of positions and colors.
+
+  -colors => [ 0, 'black', 50, 'red' ]
+
+
+=item B<-font>
+
+Specifies the desired text font for the  current (percentage)
+value to be displayed.
+
 =back
 
 =head1 WIDGET METHODS
@@ -493,6 +591,8 @@
 This program is free software; you can redistribute it and/or modify it
 under the same terms as Perl itself.
 
+ValueText-Add-On 02.2004 - 2007 by M. Krause, E<lt>F<KrauseM_AT_gmx_DOT_net>E<gt>
+
 =cut