bitmap
A bitmap (configurable via the -bitmap command, the default is an hourglass) on the left side of the WaitBox
label
A label (configurable via the -txt1 command), with text in the upper portion of the right hand frame
secondary label
Another label (configurable via the -txt2 command, the default is 'Please Wait'), with text in the lower portion of the right hand frame
userframe
A frame displayed, if required, between the label and the secondary label. For details, see the example code and the Advertised Widget section
cancel button
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.
Basic Usage
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
Configuration may be done at creation or via the configure method.
Example Code
#!/usr/local/bin/perl -w
use Tk; use Tk::WaitBox; use strict;
my($root) = MainWindow->new; my($utxt) = "Initializing...";
my($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($base) = $u->Frame(-background =>'gray', -relief => 'sunken', -borderwidth => 2, -height => 20) ->pack(-side => 'left', -anchor => 'w',-expand => 1, -fill => 'both'); my($bar) = $base->Frame(-borderwidth => 2, -relief => 'raised', -height => 20, -width => 0, -background => 'blue') ->pack(-fill => 'y', -side => 'left');
$wd->configure(-canceltext => 'Halt, Cease, Desist'); # default is 'Cancel'
$wd->Show;
for (1..15) { sleep(1); $bar->configure(-width => int($_/15*$base->Width)); $utxt = 100*$_/15 . "% Complete"; $root->update; last if !defined($utxt); }
$wd->unShow;
$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
This code may be distributed under the same conditions as perl itself.