summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/bitmaps.pl
diff options
context:
space:
mode:
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.pl44
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;