home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2004 July / APC0407D2.iso / workshop / apache / files / ActivePerl-5.6.1.638-MSWin32-x86.msi / _ca6d899335812d1623f445cfacc463a9 < prev    next >
Encoding:
Text File  |  2004-04-13  |  1.9 KB  |  59 lines
  1.  
  2.  
  3. # use subs qw(bitmapRow);
  4.  
  5.  
  6. sub bitmapRow  {
  7.  
  8.     # The procedure below creates a new row of bitmaps in a window.  Its arguments are:
  9.     #
  10.     # w -    The window reference that is to contain the row.
  11.     # args -    The names of one or more bitmaps, which will be displayed in frame $w
  12.  
  13.     my($w, @names) = @_;
  14.     my($bitmap, $wr, $wr_bit, $wr_bit_bitmap, $wr_bit_label);
  15.  
  16.     $wr = $w->Frame();
  17.     $wr->pack(-side => 'top', -fill => 'both');
  18.  
  19.     foreach $bitmap (@names) {
  20.     $wr_bit = $wr->Frame();
  21.     $wr_bit->pack(-side => 'left', -fill => 'both', -pady => '.25c', -padx => '.25c');
  22.     $wr_bit_bitmap = $wr_bit->Label(-bitmap => $bitmap);
  23.     $wr_bit_label = $wr_bit->Label(-text => $bitmap, -width => 9);
  24.     $wr_bit_label->pack(-side => 'bottom');
  25.     $wr_bit_bitmap->pack(-side => 'bottom');
  26.     }
  27.  
  28. } # end bitmapRow
  29.  
  30. sub mkBitmaps  {
  31.  
  32.     # Create a top-level window that displays all of Tk's built-in bitmaps.
  33.  
  34.     $mkBitmaps->destroy if Exists($mkBitmaps);
  35.     $mkBitmaps = $top->Toplevel();
  36.     my $w = $mkBitmaps;
  37.     dpos $w;
  38.     $w->title('Bitmap Demonstration');
  39.     $w->iconname('Bitmaps');
  40.  
  41.     my $w_msg = $w->Label(-font => '-Adobe-times-medium-r-normal--*-180-*-*-*-*-*-*', -wraplength => '4i', 
  42.                -justify => 'left', -text => 'This window displays all of Tk\'s built-in bitmaps, along with the ' .
  43.                'names you can use for them in Perl scripts.  Click the "OK" button when you\'ve seen enough.');
  44.     my $w_frame = $w->Frame();
  45.     bitmapRow $w_frame, qw(error gray25 gray50 hourglass);
  46.     bitmapRow $w_frame, qw(info question questhead warning);
  47.     my $w_ok = $w->Button(-text => 'OK', -width => 8, -command => ['destroy', $w]);
  48.     $w_msg->pack(-side => 'top', -anchor => 'center');
  49.     $w_frame->pack(-side => 'top', -expand => 'yes', -fill => 'both');
  50.     $w_ok->pack(-side => 'bottom');
  51.  
  52. } # end mkBitmaps
  53.  
  54.  
  55.  
  56.  
  57.  
  58. 1;
  59.