I have this test script below.
A toplevel containing a button that invokes another toplevel.
The first time I invoke this second window, all works fine and returns
properly without error.
however, when I reenter again (clicking on "Get Number" button) I get this
error message.
Tk::Error: not a Tk object
Tk::die_with_trace at x.pl line 46
main::AddNumber at x.pl line 66
main::__ANON__ at C:/Perl/lib/Tk.pm line 252
(eval) at C:/Perl/lib/Tk.pm line 252
Tk::__ANON__ at C:/Perl/lib/Tk/Button.pm line 111
Tk::Button::butUp at x.pl line 79
(eval) at x.pl line 79
main::GetNumber at x.pl line 17
main::__ANON__ at C:/Perl/lib/Tk.pm line 252
(eval) at C:/Perl/lib/Tk.pm line 252
Tk::__ANON__ at C:/Perl/lib/Tk/Button.pm line 111
Tk::Button::butUp at x.pl line 20
(eval) at x.pl line 20
Tk callback for .toplevel.frame.button5
Tk::__ANON__ at C:/Perl/lib/Tk.pm line 252
Tk::Button::butUp at C:/Perl/lib/Tk/Button.pm line 111
<ButtonRelease-1>
(command bound to event)
Hoping for help.
thanks.
Dan
############################################################################################
use strict;
use Tk;
use Time::HiRes qw(time usleep);
my $BGColor0 = "#D8D0C8";
my $BGColor1 = "#D0D0D0";
my $BGColor2 = "#808080";
my $BGColor3 = "#5090C0";
my $BGColor4 = "#4070A0";
my $BGColor5 = "#80C080";
my $BGColor6 = "#408040";
my $BGColor7 = "#FFFFFF";
my $BGColor8 = "#E0E0E0";
my $BGColor9 = "#FF8080";
my $mw = MainWindow->new;
$mw->title("MainWindow");
$mw->Button(-text => "Get Number",-command => sub {&GetNumber('Enter
Number')})->pack( );
while(1) {
$mw->update;
usleep 5000;
}
sub GetNumber {
my $title = shift;
my %t;
my $number = 0;
my $flag = 1;
sub AddNumber {
my $key = shift;
if ('0123456789' =~ $key) {
$number .= $key;
} elsif ($key eq 'period' && $number !~ /\./) {
$number .= '.';
} elsif ($key eq 'Return') {
$flag = 0;
} elsif ($key eq 'Escape') {
$number = '';
$flag = 0;
} elsif ($key eq 'BackSpace') {
chop($number);
chop($number) if substr($number,-1) eq '.';
}
$t{LZ}->configure(-text=>$number);
}
sub Keyboard {
my $widget = shift;
my $e = $widget->XEvent; # get event object
my $key = $e->K;
AddNumber($key);
}
$t{L0} = $mw->Toplevel(-title=>$title);
$t{L0}->resizable(0,0);
$t{L0}->transient($t{L0}->Parent->toplevel);
$t{LT} = $t{L0}->Label( -borderwidth=>2, -bg=>$BGColor3,
-fg=>'#000000', -font=>['Arial',20,'bold'], -relief=>'groove', -anchor=>"c",
-text=>$title)->pack( -side=>"top", -expand=>1, -fill=>'x', );
$t{LZ} = $t{L0}->Label( -borderwidth=>4, -bg=>$BGColor7,
-fg=>'#000000', -font=>['Arial',40,'bold'], -relief=>'groove', -anchor=>"e",
)->pack( -side=>"top", -expand=>1, -fill=>'x', );
$t{L1} = $t{L0}->Frame( -borderwidth=>2, )->pack( -side=>'left',
-expand=>1, -fill=>'both');
$t{L1}->Button( -borderwidth=>3, -bg=>$BGColor3,
-activebackground=>$BGColor4, -width=>4, -height=>1, -text => "7",
-font=>['Courier',30,'bold'], -command => sub{AddNumber('7')},
)->grid(
$t{L1}->Button( -borderwidth=>3, -bg=>$BGColor3,
-activebackground=>$BGColor4, -width=>4, -height=>1, -text => "8",
-font=>['Courier',30,'bold'], -command => sub{AddNumber('8')}, ),
$t{L1}->Button( -borderwidth=>3, -bg=>$BGColor3,
-activebackground=>$BGColor4, -width=>4, -height=>1, -text => "9",
-font=>['Courier',30,'bold'], -command => sub{AddNumber('9')}, ),
-sticky=>'news');
$t{L1}->Button( -borderwidth=>3, -bg=>$BGColor3,
-activebackground=>$BGColor4, -width=>4, -height=>1, -text => "4",
-font=>['Courier',30,'bold'], -command => sub{AddNumber('4')},
)->grid(
$t{L1}->Button( -borderwidth=>3, -bg=>$BGColor3,
-activebackground=>$BGColor4, -width=>4, -height=>1, -text => "5",
-font=>['Courier',30,'bold'], -command => sub{AddNumber('5')}, ),
$t{L1}->Button( -borderwidth=>3, -bg=>$BGColor3,
-activebackground=>$BGColor4, -width=>4, -height=>1, -text => "6",
-font=>['Courier',30,'bold'], -command => sub{AddNumber('6')}, ),
-sticky=>'news');
$t{L1}->Button( -borderwidth=>3, -bg=>$BGColor3,
-activebackground=>$BGColor4, -width=>4, -height=>1, -text => "1",
-font=>['Courier',30,'bold'], -command => sub{AddNumber('1')},
)->grid(
$t{L1}->Button( -borderwidth=>3, -bg=>$BGColor3,
-activebackground=>$BGColor4, -width=>4, -height=>1, -text => "2",
-font=>['Courier',30,'bold'], -command => sub{AddNumber('2')}, ),
$t{L1}->Button( -borderwidth=>3, -bg=>$BGColor3,
-activebackground=>$BGColor4, -width=>4, -height=>1, -text => "3",
-font=>['Courier',30,'bold'], -command => sub{AddNumber('3')}, ),
-sticky=>'news');
$t{L1}->Button( -borderwidth=>3, -bg=>$BGColor3,
-activebackground=>$BGColor4, -width=>4, -height=>1, -text => "0",
-font=>['Courier',30,'bold'], -command => sub{AddNumber('0')},
)->grid(
$t{L1}->Button( -borderwidth=>3, -bg=>$BGColor3,
-activebackground=>$BGColor4, -width=>4, -height=>1, -text => ".",
-font=>['Courier',30,'bold'], -command => sub{AddNumber('period')}, ),
$t{L1}->Button( -borderwidth=>3, -bg=>$BGColor3,
-activebackground=>$BGColor4, -width=>4, -height=>1, -text => "Enter",
-font=>['Courier',20,'bold'], -command => sub{AddNumber('Return')}, ),
-sticky=>'news');
$t{L0}->bind('<KeyPress>'=>\&Keyboard);
$t{LZ}->configure(-text=>$number);
while($flag) {
$t{L0}->focus;
$t{L0}->update;
usleep 5000;
}
$t{L0}->destroy;
return($number);
}
############################################################################################
_______________________________________________
Perl-Win32-Users mailing list
[email protected]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
