1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
use Tk;
use utf8;
use strict;
use warnings;
my($Test, $Laenge, $Meldung) = "";
my $mw = MainWindow->new();
my $ent = $mw->Entry(-textvariable=>\$Test,-validate=>'key',-validatecommand=>\&check)->pack(-side=>'top');
MainLoop();
sub check
{
if(length($Test)>1)
{
$ent->configure(-foreground=>'red');
}
else
{
$ent->configure(-foreground=>'black');
}
}
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
use Tk; use utf8; use strict; use warnings; my($Test, $Laenge, $Meldung) = ""; my $mw = MainWindow->new(); my $ent = $mw->Entry( -textvariable => \$Test, -validate => 'key', -validatecommand => \&check, )->pack(-side=>'top'); MainLoop(); sub check { my $color = 'black'; my $returncode = 1; if ( 1 < length $Test ) { $color = 'red'; } $ent->configure( -foreground => $color ); return $returncode; }
QuoteIf it returns 0 (or the valid boolean equivalent) then it means you reject the new edition and it will not occur and the invalidCommand will be evaluated if it is set. If it returns 1, then the new edition occurs.
Quotehttp://perldoc.perl.org/functions/return.html(In the absence of an explicit return, a subroutine, eval, or do FILE automatically returns the value of the last expression evaluated.)
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
#! /usr/bin/env perl use strict; use warnings; use 5.010; sub foo { my $str = shift; if ( 1 < length($str) ) { say "ok"; } else { say "no"; } } say foo("a");
1
2
3
Name "main::NOTHERE" used only once: possible typo at /tmp/foo.pl line 14.
say() on unopened filehandle NOTHERE at /tmp/foo.pl line 14.
Use of uninitialized value in say at /tmp/foo.pl line 18.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28
#!/usr/bin/perl use warnings; use strict; use Tk; use utf8; my($Test, $Laenge, $Meldung) = ""; my $mw = MainWindow->new(); my $ent = $mw->Entry(-validate => 'key', -validatecommand => \&check, -foreground => "black", -background => "white"); $ent->focus(); $ent->pack(-side=>'top', -padx => 20, -pady => 20); MainLoop(); sub check { my $Test = $ent->get(); if(length($Test)>1) { $ent->configure(-foreground => 'red'); } else { $ent->configure(-foreground => 'black'); } return 1; }