home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _ea7101a2aafe94e0c11afc8905c61177 < prev    next >
Encoding:
Text File  |  2004-06-01  |  1.2 KB  |  45 lines
  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;
  45.