Mastering Perl/Tk

Tk::MacProgressBar

MacProgressBar is a widget designed to resemble a Macintosh progress bar. See Figure 15-7 for a demonstration.

$Tk::MacProgressBar::VERSION = '1.0'; package Tk::MacProgressBar; use base qw/Tk::Frame/; use vars qw/$BASE $CAP $H $OTLW $W/; use strict; Construct Tk::Widget 'MacProgressBar'; $OTLW = 1 + 1; # inner black and outter grey outline width $BASE = 2; # left base segment width $CAP = 6; # right cap width $H = 10; # progress bar height sub Populate { # Create an instance of a MacProgressBar. Instance variable are: # # {photow} = Photo image width, including base and end cap. my($self, $args) = @_; $self->SUPER::Populate($args); my $w = $args->{-width}; $w ||= 100; $self->{photow} = $w = $w + $BASE + $CAP; my $h = 2 * $OTLW + $H; # The MacProgressbar Label and its surrounding top/left/right/bottom # Frames, plus an empty Photo for the Label's image. Pack things nicely. my $tf = $self->Frame; my $lf = $self->Frame; my $lb = $self->Label; my $rf = $self->Frame; my $bf = $self->Frame; my $i = $lb->Photo(-width => $w, -height => $h); $lb->configure(-image => $i); $tf->pack(qw/-fill both -expand 1 -side top/); $bf->pack(qw/-fill both -expand 1 -side bottom/); $lf->pack(qw/-fill both -expand 1 -side left/); $lb->pack(qw/-fill both -expand 1 -side left -ipadx 6/); $rf->pack(qw/-fill both -expand 1 -side left/); # Draw the outer and inner image outlines. my $left_top_outter = '#adadad'; my $right_bottom_outter = '#ffffff'; $i->put($left_top_outter, -to => 0, 0, $w ...