in reply to Re: Tk - non-blocking messageBox without buttons closing without user input
in thread Tk - non-blocking messageBox without buttons closing without user input
#!/usr/local/bin/perl -w # adapted from # http://search.cpan.org/src/LUSOL/Tk-Splashscreen-1.0/splashscreen.pl package Tk::Splashinfo; use Tk::widgets qw/Toplevel/; use base qw/Tk::Toplevel/; Construct Tk::Widget 'Splashinfo'; sub Populate { my ( $self, $args ) = @_; $self->withdraw; $self->overrideredirect(1); $self->SUPER::Populate($args); } 1; package main; use Tk; use Tk::Splashscreen; use Tk::widgets qw/Photo Animation/; use strict; my $mw = MainWindow->new; $mw->Button( -text => 'Quit', -command => \&exit )->pack; { my $gif89 = Tk->findINC('anim.gif'); my $splash = $mw->Splashinfo(); my $animate = $splash->Animation( -format => 'gif', -file => $gif8 +9 ); $splash->Label( -image => $animate )->pack; $animate->set_image(0); $animate->start_animation(500); $splash->Popup; # show Splashscreen $mw->Button( -text => 'Kill splash', -command => sub { $splash->destroy } )->pack; } $mw->deiconify; # show calculator MainLoop;
|
|---|