view release on metacpan or  search on metacpan

Tk/ProgressIndicator.pm  view on Meta::CPAN

package Tk::ProgressIndicator;

use Tk;
use Tk::Frame;

use base qw (Tk::Derived Tk::Frame);
use vars qw ($VERSION);
use strict;
use Carp;

$VERSION = '0.02';

Tk::Widget->Construct ('ProgressIndicator');

sub Populate
   {
    my $this = shift;

    $this->SUPER::Populate (@_);

    $this->{'m_Increment'} = 10;
    $this->{'m_Current'} = 0;
    $this->{'m_Padding'} = 1;
    $this->{'m_Limit'} = 100;

    $this->configure
       (
        '-relief' => 'sunken',
        '-borderwidth' => 2,
       );

    $this->ConfigSpecs
       (
        '-foreground' => [['SELF','PASSIVE','METHOD'], 'foreground', 'Foreground', 'blue'],
        '-increment'  => ['METHOD', 'increment', 'Increment', 10],
        '-current'    => ['METHOD', 'current', 'Current', 0],
        '-padding'    => ['METHOD', 'padding', 'Padding', 1],
        '-limit'      => ['METHOD', 'limit', 'Limit', 100],
       );

    return $this;
   }

sub Reconfigure
   {
    my $this = shift;

    my $l_CellCount = int ($this->{'m_Limit'} / $this->{'m_Increment'});

    foreach my $l_Child ($this->children())
       {
        $l_Child->destroy();
       }

    for (my $l_Index = 1; $l_Index <= $l_CellCount; ++$l_Index)
       {
        my $l_Cell = $this->Component
           (
            'Frame' => 'Cell_'.$l_Index,
            '-borderwidth' => 1,
            '-relief' => 'flat',
           );

        $l_Cell->place
           (
            '-relx' => ($l_Index - 1) * ($this->{'m_Increment'} / $this->{'m_Limit'}),