Viewing file:  bitmaps.pl (1.18 KB) -rw-r--r--
Select action/file-type:
 (+) |  (+) |  (+) | Code (+) | Session (+) |  (+) | SDB (+) |  (+) |  (+) |  (+) |  (+) |  (+) |
# bitmaps.pl
use subs qw/bitmaps_row/;
use vars qw/$TOP/;
sub bitmaps {
# Create a top-level window that displays all of Tk's built-in bitmaps.
my($demo) = @_;
$TOP = $MW->WidgetDemo(
-name => $demo,
-text => 'This window displays all of Tk\'s built-in bitmaps, along with the names you can use for them in Perl scripts.',
-title => 'Bitmap Demonstration',
-iconname => 'bitmaps',
);
my $frame = $TOP->Frame;
$frame->pack(qw/-side top -expand yes -fill both/);
bitmaps_row $frame, qw/error gray12 gray25 gray50 gray75 hourglass/;
bitmaps_row $frame, qw/info questhead question Tk transparent warning/;
} # end bitmaps
sub bitmaps_row {
# The procedure below creates a new row of bitmaps in a window.
my($w, @names) = @_;
my $row = $w->Frame->pack(qw/-side top -fill both/);
foreach my $bitmap_name (@names) {
my $bit = $row->Frame;
$bit->pack(qw/-side left -fill both -pady .25c -padx .25c/);
my $label = $bit->Label(-text => $bitmap_name, -width => 9);
$label->pack(qw/-side bottom/);
my $bitmap = $bit->Label('-bitmap' => $bitmap_name);
$bitmap->pack(qw/-side bottom/);
}
} # end bitmaps_row
1;
|