#!/usr/bin/perl -w
use strict;
use warnings;
use Tk;
my $mw = MainWindow->new();
$mw->withdraw();
my $ftp_warn = $mw->messageBox(
-title => 'Silly message',
-message => "We are displaying a silly message, do you wish to conti
+nue?",
-type => 'YesNo',
-icon => 'question',
);
if ( $ftp_warn eq 'No' ) {
exit;
}else {
my $msg2 = $mw->messageBox(
-title => 'Really?',
-message => "We displayed silly message and you wish to continue?"
+,
-type => 'OK',
-icon => 'question',
);
while (1){
print "hit control-c to exit\n";
sleep 1;
}
}
and here is a little right click popup that can be very handy.
#!/usr/bin/perl
use warnings;
use strict;
#set up main window display
use Tk;
my $mw = new MainWindow(-title => 'PopUp');
my @buttons = qw(A B C D E F G);
#popup menu set up
my $popupmenu = $mw->Menu(-tearoff => 0);
foreach my $bt (reverse @buttons){
$popupmenu->insert(0, 'command',
-label => $bt,
#-command => [sub {print $popupmenu->cget('text') ."\n"
+}],
-command => [sub {print $bt ."\n"}],
);
}
$mw->bind("<Button-3>" => sub {$popupmenu->Popup(-popover => "cursor",
-popanchor => 'nw'),
-command => [sub {print "Popup\n"}]});
MainLoop();
|