لطفا منتظر باشید ...
 |  |
15.15. Creating Dialog Boxes with Tk
15.15.1. Problem
You want to create a dialog
box, i.e., a new top-level window with buttons to make the window go
away. The dialog box might also have other items, such as labels and
text entry widgets for creating a fill-out form. You could use such a
dialog box to collect registration information, and you want it to go
away when registration is sent or if the user chooses not to
register.
15.15.2. Solution
For simple jobs, use the Tk::DialogBox
widget:use Tk::DialogBox;
$dialog = $main->DialogBox( -title => "Register This Program",
-buttons => [ "Register", "Cancel" ] );
# add widgets to the dialog box with $dialog->Add( )
# later, when you need to display the dialog box
$button = $dialog->Show( );
if ($button eq "Register") {
# ...
} elsif ($button eq "Cancel") {
# ...
} else {
# this shouldn't happen
}
15.15.3. Discussion
A DialogBox has two parts: the bottom is a set of buttons, and the
top has the widgets of your choosing. Show ing a
DialogBox pops it up and returns the button the user selected.Example 15-6 contains a complete program
demonstrating the DialogBox.
Example 15-6. tksample3
#!/usr/bin/perl -w
# tksample3 - demonstrate dialog boxes
use Tk;
use Tk::DialogBox;
$main = MainWindow->new( );
$dialog = $main->DialogBox( -title => "Register",
-buttons => [ "Register", "Cancel" ],
);
# the top part of the dialog box will let people enter their names,
# with a Label as a prompt
$dialog->add("Label", -text => "Name")->pack( );
$entry = $dialog->add("Entry", -width => 35)->pack( );
# we bring up the dialog box with a button
$main->Button( -text => "Click Here For Registration Form",
-command => \®ister) ->pack(-side => "left");
$main->Button( -text => "Quit",
-command => sub { exit } ) ->pack(-side => "left");
MainLoop;
#
# register
#
# Called to pop up the registration dialog box
#
sub register {
my $button;
my $done = 0;
do {
# show the dialog
$button = $dialog->Show;
# act based on what button they pushed
if ($button eq "Register") {
my $name = $entry->get;
if (defined($name) && length($name)) {
print "Welcome to the fold, $name\n";
$done = 1;
} else {
print "You didn't give me your name!\n";
}
} else {
print "Sorry you decided not to register.\n";
$done = 1;
}
} until $done;
}
The top part of this DialogBox has two widgets: a label and a text
entry. To collect more information from the user, we'd have more
labels and text entries.A common use of dialog boxes is to display error messages or
warnings. The program in Example 15-7 demonstrates
how to display Perl's warn function in a
DialogBox.
Example 15-7. tksample4
#!/usr/bin/perl -w
# tksample4 - popup dialog boxes for warnings
use Tk;
use Tk::DialogBox;
my $main;
# set up a warning handler that displays the warning in a Tk dialog box
BEGIN {
$SIG{_ _WARN_ _} = sub {
if (defined $main) {
my $dialog = $main->DialogBox( -title => "Warning",
-buttons => [ "Acknowledge" ]);
$dialog->add("Label", -text => $_[0])->pack;
$dialog->Show;
} else {
print STDOUT join("\n", @_), "n";
}
};
}
# your program goes here
$main = MainWindow->new( );
$main->Button( -text => "Make A Warning",
-command => \&make_warning) ->pack(-side => "left");
$main->Button( -text => "Quit",
-command => sub { exit } ) ->pack(-side => "left");
MainLoop;
# dummy subroutine to generate a warning
sub make_warning {
my $a;
my $b = 2 * $a;
}
15.15.4. See Also
The Tk::DialogBox manpage in the documentation for the Tk module from
CPAN; the menu(n) manpage (if you have it);
Mastering Perl/Tk
|  | |
| 15.14. Creating Menus with Tk |  | 15.16. Responding to Tk Resize Events |
Copyright © 2003 O'Reilly & Associates. All rights reserved.
