Tk::WaitBoxFixed - An Object Oriented Wait Dialog for Perl/Tk, of the Please Wait variety.
A WaitBoxFixed consists of a number of subwidgets:
A bitmap (configurable via the -bitmap command, the default is an hourglass) on the left side of the WaitBoxFixed
A label (configurable via the -txt1 command), with text in the upper portion of the right hand frame
Another label (configurable via the -txt2 command, the default is 'Please Wait'), with text in the lower portion of the right hand frame
A frame displayed, if required, between the label and the secondary label. For details, see the example code and the Advertised Widget section
If a cancelroutine (configured via the -cancelroutine command) is defined, a frame will be packed below the labels and bitmap, with a single button. The text of the button will be 'Cancel' (configurable via the -canceltext command), and the button will call the supplied subroutine when pressed.
To use, create your WaitDialog objects during initialization, or at least before a Show. When you wish to display the WaitDialog object, invoke the 'Show' method on the WaitDialog object; when you wish to cease displaying the WaitDialog object, invoke the 'unShow' method on the object.
Configuration may be done at creation or via the configure method.
#!/usr/local/bin/perl -w ## Dependent on Graham Barr's Tk::ProgressBar use strict; use Tk; use Tk::WaitBoxFixed; use Tk::ProgressBar; my($root) = MainWindow->new; $root->withdraw; my($utxt) = "Initializing..."; my($percent); my($wd); $wd = $root->WaitBoxFixed( -bitmap =>'questhead', # Default would be 'hourglass' -txt2 => 'tick-tick-tick', #default would be 'Please Wait' -title => 'Takes forever to get service around here', -cancelroutine => sub { print "\nI'm canceling....\n"; $wd->unShow; $utxt = undef; }); $wd->configure(-txt1 => "Hurry up and Wait, my Drill Sergeant told me"); $wd->configure(-foreground => 'blue',-background => 'white'); ### Do something quite boring with the user frame my($u) = $wd->{SubWidget}{uframe}; $u->pack(-expand => 1, -fill => 'both'); $u->Label(-textvariable => \$utxt)->pack(-expand => 1, -fill => 'both'); ## It would definitely be better to do this with a canvas... this is dumb my($bar) = $u->ProgressBar( -variable => \$percent, -blocks => 0, -width => 20, -colors => [ 0 => 'green', 30 => 'yellow', 50 => 'orange', 80 => 'red'], ) ->pack(-expand =>1, -fill =>'both'); $wd->configure(-canceltext => 'Halt, Cease, Desist'); # default is 'Cancel' $wd->Show; my($diff) = 240; for (1..$diff) { $percent = int($_/$diff*100); $utxt = sprintf("%5.2f%% Complete",$percent); $bar->update; last if !defined($utxt); } sleep(2); $wd->unShow;
uframe is a frame created between the two messages. It may be used for anything the user has in mind... including exciting cycle wasting displays of sand dropping through an hour glass, Zippy riding either a Gnu or a bronc, et cetera.
Assuming that the WaitBoxFixed is referenced by $w, the uframe may be addressed as $w->subwidget{uframe}. Having gotten the address, you can do anything (I think) you would like with it
$w
$w->subwidget{uframe}
Specifying -takeFocus => 0 will prevent the WaitBoxFixed widget from taking focus. Default is to take focus and do an application grab. I'm not sure why, but someone told me it was necessary.
-takeFocus => 0
Brent B. Powers, (B2Pi) Powers@B2Pi.com
Copyright(c) 1996-2000 Brent B. Powers. All rights reserved. This program is free software, you may redistribute it and/or modify it under the same terms as Perl itself.
Rene Schickbauer cavac@cpan.org
(C) 2013-2018, Rene Schickbauer, same license
Alexander Becker, asb@cpan.org
(C) 2016-2018 Alexander Becker, same license
To install Tk::WaitBoxFixed, copy and paste the appropriate command in to your terminal.
cpanm
cpanm Tk::WaitBoxFixed
CPAN shell
perl -MCPAN -e shell install Tk::WaitBoxFixed
For more information on module installation, please visit the detailed CPAN module installation guide.