home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _c37f3b10a4e4612bcd178a81f1557025 < prev    next >
Encoding:
Text File  |  2004-06-01  |  2.1 KB  |  62 lines
  1. # msgBox.pl
  2.  
  3. use vars qw/$TOP/;
  4.  
  5. sub msgBox {
  6.     my($demo) = @_;
  7.     $TOP = $MW->WidgetDemo(
  8.         -name             => $demo,
  9.         -text             => 'Choose the icon and type option of the message box. Then press the "Message Box" button to see the message box.',
  10.         -title            => 'messageBox Demo',
  11.         -iconname         => 'messageBox',
  12.     );
  13.  
  14.     my $upper = $TOP->Frame->pack;
  15.     my $left = $upper->Frame;
  16.     my $right = $upper->Frame;
  17.     $left->pack(qw/-side left -expand yes -fill y  -pady .5c -padx .5c/);
  18.     $right->pack(qw/-side left -expand yes -fill y  -pady .5c -padx .5c/);
  19.  
  20.     my $icon = $left->Label(qw/-text Icon/);
  21.     my $lsep = $left->Frame(qw/-relief ridge -bd 1 -height 2/);
  22.     $icon->pack(qw/-side top/);
  23.     $lsep->pack(qw/-side top -fill x -expand no/);
  24.  
  25.     my $iconvar = 'info';
  26.     foreach my $i (qw/error info question warning/) {
  27.     $left->Radiobutton(-text => $i, -variable => \$iconvar, -value => $i,
  28.                qw/-width 16 -anchor w -relief flat/)->pack(
  29.                qw/-side top -pady 2 -anchor w -fill x/);
  30.     }
  31.  
  32.  
  33.     my $rl = $right->Label(qw/-text Type/);
  34.     my $rsep = $right->Frame(qw/-relief ridge -bd 1 -height 2/);
  35.     $rl->pack(qw/-side top/);
  36.     $rsep->pack(qw/-side top -fill x -expand no/);
  37.  
  38.     my $typevar = 'OK';
  39.     foreach my $t (qw/AbortRetryIgnore OK OKCancel RetryCancel YesNo YesNoCancel/) {
  40.     $right->Radiobutton(-text => $t, -variable => \$typevar, -value => $t,
  41.                 qw/-relief flat -width 16 -anchor w/)->pack(
  42.                 qw/-side top -pady 2 -anchor w -fill x/);
  43.     }
  44.  
  45.     my $show = $TOP->Button(-text => "Message Box",
  46.                 -command => [\&show_messageBox, \$iconvar, \$typevar]);
  47.     $show->pack;
  48.  
  49. } # end msgBox
  50.  
  51. sub show_messageBox {
  52.     my($iconvar, $typevar) = @_;
  53.  
  54.     my $button = $TOP->messageBox('-icon' => $$iconvar, -type => $$typevar,
  55.     -title => 'Message',
  56.         -message => "This is a \"$$typevar\" type messagebox with the \"$$iconvar\" icon");
  57.  
  58.     $TOP->messageBox(qw/-icon info -type OK -message/ => "You have selected \"$button\"");
  59.  
  60. } # end show_messageBox
  61.  
  62.