view release on metacpan or  search on metacpan

Tk/ProgressBar.pm  view on Meta::CPAN

package Tk::ProgressBar;

use vars qw($VERSION);
$VERSION = '4.015'; # was: sprintf '4.%03d', q$Revision: #10 $ =~ /\D(\d+)\s*$/;

use Tk;
use Tk::Canvas;
use Tk::Trace;
use Carp;
use strict;

use base qw(Tk::Derived Tk::Canvas);

Construct Tk::Widget 'ProgressBar';

sub ClassInit {
    my ($class,$mw) = @_;

    $class->SUPER::ClassInit($mw);

    $mw->bind($class,'<Configure>', ['_layoutRequest',1]);
}

my $LAYOUT_REQUEST_NONE   = 0;
my $LAYOUT_REQUEST_COLORS = 1;
my $LAYOUT_REQUEST_VALUE  = 2;
my $LAYOUT_REQUEST_GEOM   = 4;

sub Populate {
    my($c,$args) = @_;

    $c->ConfigSpecs(
	-width    => [PASSIVE => undef, undef, 0],
	'-length' => [PASSIVE => undef, undef, 0],
	-from	  => [PASSIVE => undef, undef, 0],
	-to	  => [PASSIVE => undef, undef, 100],
	-blocks   => [PASSIVE => undef, undef, 10],
	-padx     => [PASSIVE => 'padX', 'Pad', 0],
	-pady     => [PASSIVE => 'padY', 'Pad', 0],
	-gap      => [PASSIVE => undef, undef, 1],
	-colors   => [PASSIVE => undef, undef, undef],
	-relief	  => [SELF => 'relief', 'Relief', 'sunken'],
	-value    => [METHOD  => undef, undef, undef],
	-variable => [METHOD  => undef, undef, undef],
	-anchor   => [METHOD  => 'anchor', 'Anchor', 'w'],
	-resolution
		  => [PASSIVE => undef, undef, 1.0],
	-highlightthickness
		  => [SELF => 'highlightThickness','HighlightThickness',0],
	-troughcolor
		  => [PASSIVE => 'troughColor', 'Background', 'grey55'],
    );
    $c->_layoutRequest($LAYOUT_REQUEST_COLORS);
    $c->OnDestroy(['Destroyed' => $c]);
}

sub ConfigChanged {
    my($c, $changed) = @_;
    for my $k (qw(from to blocks padx pady gap colors resolution troughcolor)) {
	if (exists $changed->{"-$k"}) {
	    $c->_layoutRequest($LAYOUT_REQUEST_COLORS);
	    last;
	}
    }
    for my $k (qw(borderwidth length width)) {
	if (exists $changed->{"-$k"}) {
	    $c->_layoutRequest($LAYOUT_REQUEST_GEOM);
	    last;
	}
    }
}