home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _1ba14717ef2ba9754ce614fb60d752fe < prev    next >
Text File  |  2004-06-01  |  3KB  |  79 lines
  1. # radio.pl
  2.  
  3. use Tk::widgets qw/LabFrame/;
  4. use vars qw/$TOP/;
  5.  
  6. sub radio {
  7.  
  8.     # Create a top-level window that displays a bunch of radio buttons.
  9.  
  10.     my($demo) = @_;
  11.     $TOP = $MW->WidgetDemo(
  12.         -name     => $demo,
  13.         -text     => ['Two groups of radiobuttons are displayed below.  If you click on a button then the button will become selected exclusively among all the buttons in its group.  A Perl variable is associated with each group to indicate which of the group\'s buttons is selected.  Click the "See Variables" button to see the current values of the variables.', qw/-wraplength 5i/],
  14.         -title    => 'Radiobutton Demonstration',
  15.         -iconname => 'radio',
  16.     );
  17.  
  18.     my $var = $TOP->Button(
  19.         -text    => 'See Variables',
  20.         -command => [\&see_vars, $TOP, [
  21.                                       ['point size', \$POINT_SIZE],
  22.                                       ['color',      \$COLOR],
  23.                                       ['alignment',  \$ALIGN],
  24.                       ]
  25.              ],
  26.     );
  27.     $var->pack(qw/-side bottom -expand 1/);
  28.  
  29.     my @pl = qw/-side left -expand 1 -padx .5c -pady .5c/;
  30.     my $left  = $TOP->LabFrame(-label => 'Point Size')->pack(@pl);
  31.     my $mid   = $TOP->LabFrame(-label => 'Color')->pack(@pl);
  32.     my $right = $TOP->LabFrame(-label => 'Alignment')->pack(@pl);
  33.  
  34.     @pl = qw/-side top -pady 2 -anchor w/;
  35.     foreach my $p (10, 12, 18, 24) {
  36.     $left->Radiobutton(
  37.             -text     => "Point Size $p",
  38.             -variable => \$POINT_SIZE,
  39.             -relief   => 'flat',
  40.             -value    => $p,
  41.         )->pack(@pl);
  42.     }
  43.  
  44.     foreach my $c (qw/Red Green Blue Yellow Orange Purple/) {
  45.     $mid->Radiobutton(
  46.             -text     => $c,
  47.             -variable => \$COLOR,
  48.             -relief   => 'flat',
  49.             -value    => lc($c),
  50.             -command  => sub {$mid->configure(-foreground => $c)},
  51.         )->pack(@pl);
  52.     }
  53.  
  54.     my $l = $right->Label(qw/-text Label -bitmap questhead -compound left/);
  55.     $l->configure(-width  => $l->reqwidth, -compound => 'top');
  56.     $l->configure(-height => $l->reqheight);
  57.     my %w;
  58.     foreach my $a (qw/Top Left Right Bottom/) {
  59.     my $lower = lc $a;
  60.     $w{$lower} = $right->Radiobutton(
  61.             -text        => $a,
  62.             -variable    => \$ALIGN,
  63.         -relief      => 'flat',
  64.             -value       => $lower,
  65.             -indicatoron => 0,
  66.             -width       => 7,
  67.         -command     => sub {
  68.         $l->configure(-compound => $ALIGN);
  69.         },
  70.         );
  71.     }
  72.     Tk::grid('x', $w{'top'});
  73.     $w{'left'}->grid($l, $w{'right'});
  74.     Tk::grid('x', $w{'bottom'});
  75.  
  76. } # end radio
  77.  
  78. 1;
  79.