#!/usr/local/bin/perl use strict; use warnings; use Tk; use Tk::EntryCheck; my $entry_val; my $mw = MainWindow->new; $mw->geometry("500x200"); $mw->title("Value Entry"); my $mf = $mw->Frame()->pack(-side => 'top', -fill => 'x'); my $tf = $mf->Frame(-background => "red")->pack(-side => 'top', -fill =>'x'); my $lf = $mf->Frame(-background => "black")->pack(-side => 'left', -fill => 'y'); my $rf = $mf->Frame(-background => "white")->pack(-side => "right"); $tf->Label(-text => "Value Entry", -background => "red")->pack(-side =>"top"); $lf->Label(-text => "Enter value:", -background => "black", -foreground => "yellow")->pack(-side => "left"); my $entry = $lf->EntryCheck( -validate => "all" )->pack(-side => "left"); my $copy_button = $lf->Button(-text => "Copy Value", -command => \©_values)->pack(-side => "right"); my $clear_entries = $rf->Button(-text => "Clear Value", -command => \&clear_entries)->pack(-side => "top"); my $paste_entries = $rf->Text(-background => "black", -foreground => "green")->pack(-side => "top"); sub handleEvent { my ($new_val, $chars_2_change, $curr_val, $index, $action) = @_; if (!$chars_2_change && $action != -1) { return; } print $new_val."\n"; } sub clear_entries { $paste_entries->delete('0.0', 'end'); } sub copy_values { my $copied_text = $entry->get(); $paste_entries->insert("end", $copied_text); } MainLoop;