perl 创建对话框与Tk

[perl]代码库

#-----------------------------
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
}
#-----------------------------
# download the following standalone program
#!/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 => \&register)    ->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;
}

#-----------------------------
# download the following standalone program
#!/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;
}

#-----------------------------