Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # bitmaps.pl |
2 | ||
3 | use subs qw/bitmaps_row/; | |
4 | use vars qw/$TOP/; | |
5 | ||
6 | sub bitmaps { | |
7 | ||
8 | # Create a top-level window that displays all of Tk's built-in bitmaps. | |
9 | ||
10 | my($demo) = @_; | |
11 | $TOP = $MW->WidgetDemo( | |
12 | -name => $demo, | |
13 | -text => 'This window displays all of Tk\'s built-in bitmaps, along with the names you can use for them in Perl scripts.', | |
14 | -title => 'Bitmap Demonstration', | |
15 | -iconname => 'bitmaps', | |
16 | ); | |
17 | ||
18 | my $frame = $TOP->Frame; | |
19 | $frame->pack(qw/-side top -expand yes -fill both/); | |
20 | bitmaps_row $frame, qw/error gray12 gray25 gray50 gray75 hourglass/; | |
21 | bitmaps_row $frame, qw/info questhead question Tk transparent warning/; | |
22 | ||
23 | } # end bitmaps | |
24 | ||
25 | sub bitmaps_row { | |
26 | ||
27 | # The procedure below creates a new row of bitmaps in a window. | |
28 | ||
29 | my($w, @names) = @_; | |
30 | ||
31 | my $row = $w->Frame->pack(qw/-side top -fill both/); | |
32 | ||
33 | foreach my $bitmap_name (@names) { | |
34 | my $bit = $row->Frame; | |
35 | $bit->pack(qw/-side left -fill both -pady .25c -padx .25c/); | |
36 | my $label = $bit->Label(-text => $bitmap_name, -width => 9); | |
37 | $label->pack(qw/-side bottom/); | |
38 | my $bitmap = $bit->Label('-bitmap' => $bitmap_name); | |
39 | $bitmap->pack(qw/-side bottom/); | |
40 | } | |
41 | ||
42 | } # end bitmaps_row | |
43 | ||
44 | 1; |