Tk::WaitBox - An Object Oriented Wait Dialog for Perl/Tk, of the Please Wait variety. |
Tk::WaitBox - An Object Oriented Wait Dialog for Perl/Tk, of the Please Wait variety.
A WaitBox consists of a number of subwidgets:
A bitmap (configurable via the -bitmap command, the default is an hourglass) on the left side of the WaitBox
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.
## Dependent on Graham Barr's Tk::ProgressBar use strict;
use Tk; use Tk::WaitBox; use Tk::ProgressBar;
my($root) = MainWindow->new; $root->withdraw; my($utxt) = "Initializing..."; my($percent);
my($wd); $wd = $root->WaitBox( -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;
Assuming that the WaitBox 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
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.
Tk::WaitBox - An Object Oriented Wait Dialog for Perl/Tk, of the Please Wait variety. |