Re: 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, $/; }
[download]

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.	[reply] [d/l] [select]
Re^3: Tk::LabEntry - how to reach the configuration of label via callback? by capfan (Sexton) on Feb 10, 2016 at 20:53 UTC
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, $/; } [download] For me, this returned: `$VAR1 = [ bless( { '_TkValue_' => '.labentry.entry', '_XEvent_' => bless( do{\(my $o = ' $ ÿÿÿÿü˜ï +¬ œ¿ê Tç® t û A a A (ø \ +'ààï ù a ¼èˆ ä"¶ÔŒ')}, 'XEvent' ) }, 'Tk::Entry' ) ];` [download] It's a `Tk::Entry` inside a LabEntry (cf. `.labentry.entry`).	[reply] [d/l] [select]


good chemistry is complicated, and a little bit messy -LW
	PerlMonks