1package Tk::ProgressIndicator; 2 3use Tk; 4use Tk::Frame; 5 6use base qw (Tk::Derived Tk::Frame); 7use vars qw ($VERSION); 8use strict; 9use Carp; 10 11$VERSION = '0.02'; 12 13Tk::Widget->Construct ('ProgressIndicator'); 14 15sub Populate 16 { 17 my $this = shift; 18 19 $this->SUPER::Populate (@_); 20 21 $this->{'m_Increment'} = 10; 22 $this->{'m_Current'} = 0; 23 $this->{'m_Padding'} = 1; 24 $this->{'m_Limit'} = 100; 25 26 $this->configure 27 ( 28 '-relief' => 'sunken', 29 '-borderwidth' => 2, 30 ); 31 32 $this->ConfigSpecs 33 ( 34 '-foreground' => [['SELF','PASSIVE','METHOD'], 'foreground', 'Foreground', 'blue'], 35 '-increment' => ['METHOD', 'increment', 'Increment', 10], 36 '-current' => ['METHOD', 'current', 'Current', 0], 37 '-padding' => ['METHOD', 'padding', 'Padding', 1], 38 '-limit' => ['METHOD', 'limit', 'Limit', 100], 39 ); 40 41 return $this; 42 } 43 44sub Reconfigure 45 { 46 my $this = shift; 47 48 my $l_CellCount = int ($this->{'m_Limit'} / $this->{'m_Increment'}); 49 50 foreach my $l_Child ($this->children()) 51 { 52 $l_Child->destroy(); 53 } 54 55 for (my $l_Index = 1; $l_Index <= $l_CellCount; ++$l_Index) 56 { 57 my $l_Cell = $this->Component 58 ( 59 'Frame' => 'Cell_'.$l_Index, 60 '-borderwidth' => 1, 61 '-relief' => 'flat', 62 ); 63 64 $l_Cell->place 65 ( 66 '-relx' => ($l_Index - 1) * ($this->{'m_Increment'} / $this->{'m_Limit'}), 67 '-relwidth' => $this->{'m_Increment'} / $this->{'m_Limit'}, 68 '-width' => - $this->{'m_Padding'}, 69 '-relheight' => '1.0', 70 '-height' => -1, 71 '-y' => 0, 72 ); 73 } 74 75 $this->configure 76 ( 77 '-current' => $this->cget ('-current') 78 ); 79 } 80 81sub limit 82 { 83 my ($this, $p_Limit) = @_; 84 85 if (defined ($p_Limit)) 86 { 87 $this->{'m_Limit'} = $p_Limit; 88 $this->Reconfigure(); 89 } 90 91 return $this->{'m_Limit'}; 92 } 93 94sub increment 95 { 96 my ($this, $p_Increment) = @_; 97 98 if (defined ($p_Increment)) 99 { 100 $this->{'m_Increment'} = $p_Increment; 101 $this->Reconfigure(); 102 } 103 104 return $this->{'m_Current'}; 105 } 106 107sub current 108 { 109 my ($this, $p_Current) = @_; 110 111 if (defined ($p_Current)) 112 { 113 my $l_UpTo = int (($this->{'m_Current'} = $p_Current) / $this->{'m_Increment'}); 114 115 my $l_CellCount = int ($this->{'m_Limit'} / $this->{'m_Increment'}); 116 117 for (my $l_Index = 1; $l_Index <= $l_CellCount; ++$l_Index) 118 { 119 my $l_Cell = $this->Subwidget ('Cell_'.$l_Index); 120 121 next unless Exists ($l_Cell); 122 123 $l_Cell->configure 124 ( 125 '-background' => ($l_Index <= $l_UpTo ? $this->cget ('-foreground') : $this->cget ('-background')) 126 ); 127 } 128 } 129 130 return $this->{'m_Current'}; 131 } 132 133sub foreground 134 { 135 my ($this, $p_Foreground) = @_; 136 137 if (defined ($p_Foreground)) 138 { 139 $this->{'m_Foreground'} = $p_Foreground; 140 $this->Reconfigure(); 141 } 142 143 return $this->{'m_Foreground'}; 144 } 145 146sub padding 147 { 148 my ($this, $p_Padding) = @_; 149 150 if (defined ($p_Padding)) 151 { 152 $this->{'m_Padding'} = $p_Padding; 153 $this->Reconfigure(); 154 } 155 156 return $this->{'m_Padding'}; 157 } 158 1591; 160 161__END__ 162 163=cut 164 165=head1 NAME 166 167Tk::ProgressIndicator - Another, simpler ProgressBar 168 169=head1 SYNOPSIS 170 171 use Tk::ProgressIndicator; 172 173 my $MainWindow = MainWindow->new(); 174 175 $ProgressIndicator = $MainWindow->ProgressIndicator 176 ( 177 '-current' => 0, 178 '-limit' => 200, 179 '-increment' => 10, 180 '-height' => 20, 181 '-width' => 400 182 ); 183 184 Tk::MainLoop; 185 186 ... 187 188 $ProgressIndicator->configure ('-current' => ++$index); 189 190=head1 DESCRIPTION 191 192A progress bar widget. 193 194=head1 AUTHORS 195 196Damion K. Wilson, dkw@rcm.bm 197 198=head1 HISTORY 199 200=cut 201