summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/msgBox.pl
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/msgBox.pl')
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/msgBox.pl82
1 files changed, 82 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/msgBox.pl b/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/msgBox.pl
new file mode 100644
index 00000000000..4ac739519e8
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/msgBox.pl
@@ -0,0 +1,82 @@
+# msgBox.pl
+
+use vars qw/$TOP/;
+
+sub msgBox {
+ my($demo) = @_;
+ $TOP = $MW->WidgetDemo(
+ -name => $demo,
+ -text => 'Choose the icon and type option of the message box. Then press the "Message Box" button to see the message box.',
+ -title => 'messageBox Demo',
+ -iconname => 'messageBox',
+ );
+
+ my $upper = $TOP->Frame->pack;
+ my $left = $upper->Frame;
+ my $right = $upper->Frame;
+ $left->pack(qw/-side left -expand yes -fill y -pady .5c -padx .5c/);
+ $right->pack(qw/-side left -expand yes -fill y -pady .5c -padx .5c/);
+
+ my $icon = $left->Label(qw/-text Icon/);
+ my $lsep = $left->Frame(qw/-relief ridge -bd 1 -height 2/);
+ $icon->pack(qw/-side top/);
+ $lsep->pack(qw/-side top -fill x -expand no/);
+
+ my $iconvar = 'info';
+ foreach my $i (qw/error info question warning/) {
+ $left->Radiobutton(-text => $i, -variable => \$iconvar, -value => $i,
+ qw/-width 16 -anchor w -relief flat/)->pack(
+ qw/-side top -pady 2 -anchor w -fill x/);
+ }
+
+
+ my $rl = $right->Label(qw/-text Type/);
+ my $rsep = $right->Frame(qw/-relief ridge -bd 1 -height 2/);
+ $rl->pack(qw/-side top/);
+ $rsep->pack(qw/-side top -fill x -expand no/);
+
+ my $typevar = 'OK';
+ foreach my $t (qw/AbortRetryIgnore OK OKCancel RetryCancel YesNo YesNoCancel/) {
+ $right->Radiobutton(-text => $t, -variable => \$typevar, -value => $t,
+ qw/-relief flat -width 16 -anchor w/)->pack(
+ qw/-side top -pady 2 -anchor w -fill x/);
+ }
+
+ {
+ my $cbf = $TOP->Frame->pack(-fill => 'x', -padx => '.5c', -pady => 3);
+ my $fd;
+ my $fdb = $cbf->Radiobutton
+ (-text => 'Tk::DialogBox',
+ -variable => \$fd,
+ -value => 'DialogBox',
+ -command => sub { local($^W) = 0;
+ *Tk::tk_messageBox = sub{ Tk::MessageBox('tk_messageBox', @_) };
+ })->pack(-side => 'left');
+ $cbf->Radiobutton
+ (-text => 'Tk::MsgBox',
+ -variable => \$fd,
+ -value => 'MsgBox',
+ -command => sub { local($^W) = 0;
+ require Tk::MsgBox;
+ Tk::MsgBox->import('as_default');
+ })->pack(-side => 'left');
+ $fdb->invoke;
+ }
+
+ my $show = $TOP->Button(-text => "Message Box",
+ -command => [\&show_messageBox, \$iconvar, \$typevar]);
+ $show->pack;
+
+} # end msgBox
+
+sub show_messageBox {
+ my($iconvar, $typevar) = @_;
+
+ my $button = $TOP->messageBox('-icon' => $$iconvar, -type => $$typevar,
+ -title => 'Message',
+ -message => "This is a \"$$typevar\" type messagebox with the \"$$iconvar\" icon");
+
+ $TOP->messageBox(qw/-icon info -type OK -message/ => "You have selected \"$button\"");
+
+} # end show_messageBox
+