O'Reilly logo

Mastering Perl/Tk by Nancy Walsh, Stephen Lidie

Stay ahead with the world's most comprehensive technology and business learning platform.

With Safari, you learn the way you learn best. Get unlimited access to videos, live online training, learning paths, books, tutorials, and more.

Start Free Trial

No credit card required

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 ...

With Safari, you learn the way you learn best. Get unlimited access to videos, live online training, learning paths, books, interactive tutorials, and more.

Start Free Trial

No credit card required