Tk::TipEntry - Eingabefeld mit Hinweistext

Man sieht es öfter auf Webseiten: Eingabefelder mit einem Hinweistext, der im Eingabefeld steht. Tk::TipEntry bietet diese Funktionalität auch für Perl/Tk.

Standardmäßig zeigt das Widget einen per Option -tip konfigurierbaren Text an. Wird in das Entry hineingeklickt verschwindet der Text.

Wenn das Widget den Fokus verliert, wird der enthaltene Text als neuer Tip-Text übernommen. Ausnahme: wenn der Text leer ist, wird auf den vorherigen Tip zurückgegriffen.

Nachfolgendes Beispiel kann zur Veranschaulichung ausgeführt werden. Es bietet einen Button, mit dem der Fokus vom Entry abgezogen werden kann.

#!perl

use strict;
use warnings;
use Tk;
use Tk::TipEntry;
use Data::Validate::Email qw(is_email);

my $mw = tkinit(-bg => 'white', -pady => 5);

my $frame1 = $mw->Frame(
    -bg => 'white',
)->pack(-fill => 'x', -expand => 0);

$frame1->Label(
    -text => 'Enter e-mail address:',
    -bg => 'white',
)->pack(-side => 'left', -padx => 5,);

my $te = $frame1->TipEntry(
    -tip => 'enter something...',
    -bg => 'white',
)->pack(-side => 'left', -fill => 'x',-expand => 1,);

my $submit_btn = $frame1->Button(
    -text => 'Submit',
)->pack(-side => 'left', -padx => 5,);

my $frame2 = $mw->Frame(
    -bg => 'white',
)->pack(-fill => 'both', -expand => 0);

my $l2 = $frame2->Label(
    -text => 'Insert your e-mail address and submit it. '
        . 'It won\'t harm you...',
    -bg => 'white',
)->pack(-fill => 'x', -expand => 1);

$submit_btn->configure(
    -command => sub{
        my $te_val = $te->get();
        if( $te_val && $te_val ne '' 
                && $te_val ne $te->cget('-tip') ) {
            if( is_email($te_val) ) {
                $l2->configure(
                    -text => 'Congratulations! '
                        . 'You passed some sort of test.'
                );
            }else{
                $l2->configure(
                    -text => 'Your input does not '
                        . 'look like an e-mail address.'
                );
            }
        }else{
            $l2->configure(-text => 'Please enter something!');
        }
    },
);

$mw->MainLoop();
exit(0);
Top