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