diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/bitmaps.pl')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/bitmaps.pl | 44 |
1 files changed, 44 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/bitmaps.pl b/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/bitmaps.pl new file mode 100644 index 00000000000..8001e884b2d --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/bitmaps.pl @@ -0,0 +1,44 @@ +# 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; |