Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Re: Tk::LabEntry - how to reach the configuration of label via callback?

by capfan (Sexton)
on Feb 08, 2016 at 13:33 UTC ( #1154624=note: print w/replies, xml ) Need Help??


in reply to Tk::LabEntry - how to reach the configuration of label via callback?

Hi! Yuu could also use the subwidget command on the LabEntry:

#!/perl use strict; use warnings FATAL => qw(all); use Tk; use Tk::LabEntry; use List::Util qw(first); use Scalar::Util qw(looks_like_number); my $mw = MainWindow->new(); $mw->title("Test"); my $test = 8; my $width = 250; my $length = 125; $mw->minsize($width, $length); my $FONT = $mw->fontCreate(-family => 'verdana', -size => 14, -weight => 'normal'); my $le = $mw->LabEntry(-label => 'Value', -labelPack => [qw/-side left -anchor w/], -labelFont => '9x15bold', -font => $FONT, -relief => 'ridge', -textvariable => \$test, -width => 2, )->pack(); $le->bind('<Key>' => sub { labelCheck($_[0]);}); MainLoop; sub labelCheck { my $x = $_[0]->get(); if ( !(looks_like_number($x)) or ($x < 0) ) { $_[0]->delete(0, 'end'); my $label = $le->Subwidget('label'); $label->configure( -background => 'red'); # $_[0]->configure( -labelBackground => 'red'); } else { $_[0]->configure( -background => '#f0f0f0',); # $_[0]->configure( -labelBackground => '#f0f0f0'); do_something(); } return 1; } sub do_something { print $test, $/; }
  • Comment on Re: Tk::LabEntry - how to reach the configuration of label via callback?
  • Download Code

Replies are listed 'Best First'.
Re^2: Tk::LabEntry - how to reach the configuration of label via callback?
by vagabonding electron (Curate) on Feb 08, 2016 at 17:46 UTC

    Hi capfan and thank you very much for your help. The code works. However it calls the certain LabEntry from within the callback (with $le->Subwidget('label')). What I am trying to do is to create the same behavior for several LabEntry's, therefore I do not want to call the specific widget by name. The proposal of beech with $_[0]->parent->configure seems to meet this requirement.

      Yeah, that was just lazyness, sorry. You can substitute the $le by $_[0]->parent.

      You can see what is inside $_[0] by checking @_:

      #!/perl use strict; use warnings FATAL => qw(all); use Tk; use Tk::LabEntry; use Data::Dumper qw/Dumper/; use List::Util qw(first); use Scalar::Util qw(looks_like_number); my $mw = MainWindow->new(); $mw->title("Test"); my $test = 8; my $width = 250; my $length = 125; $mw->minsize($width, $length); my $FONT = $mw->fontCreate(-family => 'verdana', -size => 14, -weight => 'normal'); my $le = $mw->LabEntry(-label => 'Value', -labelPack => [qw/-side left -anchor w/], -labelFont => '9x15bold', -font => $FONT, -relief => 'ridge', -textvariable => \$test, -width => 2, )->pack(); $le->bind('<Key>' => sub { labelCheck($_[0]);}); MainLoop; sub labelCheck { print Dumper \@_; my $x = $_[0]->get(); if ( !(looks_like_number($x)) or ($x < 0) ) { $_[0]->delete(0, 'end'); my $label = $_[0]->parent->Subwidget('label'); $label->configure( -background => 'red'); # $_[0]->configure( -labelBackground => 'red'); } else { $_[0]->configure( -background => '#f0f0f0',); # $_[0]->configure( -labelBackground => '#f0f0f0'); do_something(); } return 1; } sub do_something { print $test, $/; }

      For me, this returned:

      $VAR1 = [ bless( { '_TkValue_' => '.labentry.entry', '_XEvent_' => bless( do{\(my $o = ' $  +  T  t  A  a  A ( \ +' a "Ԍ')}, 'XEvent' ) }, 'Tk::Entry' ) ];

      It's a Tk::Entry inside a LabEntry (cf. .labentry.entry).

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1154624]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (3)
As of 2023-02-02 07:21 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    I prefer not to run the latest version of Perl because:







    Results (15 votes). Check out past polls.

    Notices?