home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _4314ff7fe9b012e52c210108da4205ef < prev    next >
Text File  |  2004-06-01  |  2KB  |  65 lines
  1. # icon.pl
  2.  
  3. use vars qw/$TOP/;
  4.  
  5. sub icon {
  6.  
  7.     # Create a top-level window that displays a bunch of iconic buttons.
  8.  
  9.     my($demo) = @_;
  10.     $TOP = $MW->WidgetDemo(
  11.         -name     => $demo,
  12.         -text     => ['This window shows three ways of using bitmaps or images in radiobuttons and checkbuttons.  On the left are two radiobuttons, each of which displays a bitmap and an indicator.  In the middle is a checkbutton that displays a different image depending on whether it is selected or not.  On the right is a checkbutton that displays a single bitmap but changes its background color to indicate whether or not it is selected.', qw/-wraplength 5i/],
  13.         -title    => 'Iconic Button Demonstration',
  14.         -iconname => 'icon',
  15.     );
  16.  
  17.     $TOP->Bitmap('flagup',
  18.         -file     => Tk->findINC('demos/images/flagup'),
  19.     -maskfile => Tk->findINC('demos/images/flagup'),
  20.     );
  21.     $TOP->Bitmap('flagdown',
  22.         -file     => Tk->findINC('demos/images/flagdown'),
  23.     -maskfile => Tk->findINC('demos/images/flagdown'),
  24.     );
  25.  
  26.     my $frame = $TOP->Frame(qw/-borderwidth 10/);
  27.     $frame->pack(qw/-side top/);
  28.  
  29.     my(@pl) = qw/-side left -expand yes -padx 5m/;
  30.     my $frame_left = $frame->Frame;
  31.     $frame_left->pack(@pl);
  32.  
  33.     my $frame_b1 = $frame->Checkbutton(
  34.         -image            => 'flagdown',
  35.         -selectimage      => 'flagup',
  36.         -indicatoron      => 0,
  37.     );
  38.     $frame_b1->pack(@pl);
  39.     $frame_b1->configure(-selectcolor => $frame_b1->cget(-background));
  40.     my $frame_b2 = $frame->Checkbutton(
  41.         -bitmap      => '@' . Tk->findINC('demos/images/letters'),
  42.         -indicatoron => 0,
  43.     -selectcolor => 'SeaGreen1',
  44.     );
  45.     $frame_b2->pack(@pl);
  46.  
  47.     my $letters = '';
  48.     @pl = qw/-side top -expand yes/;
  49.     my $frame_left_b3 = $frame_left->Radiobutton(
  50.         -bitmap   => '@' . Tk->findINC('demos/images/letters'),
  51.         -variable => \$letters,
  52.         -value    => 'full',
  53.     );
  54.     $frame_left_b3->pack(@pl);
  55.     my $frame_left_b4 = $frame_left->Radiobutton(
  56.         -bitmap   => '@' . Tk->findINC('demos/images/noletters'),
  57.         -variable => \$letters,
  58.         -value    => 'empty',
  59.     );
  60.     $frame_left_b4->pack(@pl);
  61.  
  62. } # end icon
  63.  
  64. 1;
  65.