perl tk how to limit the amount of text typed into a text widget

john.tm has asked for the wisdom of the Perl Monks concerning the following question:

Hi Monks I have a tk: script that creates a user form. Once it is completed, another scripts takes a screenshot of the completed form and adds it to the body of an email ready to be sent. Therefore i need to limit the amount of lines or number of characters that are allowed in each box , As any text that is scrolled of the page will not be captured by a screen shot.

#---------------------------------------------------------------------
+-------------------------------------
#  Test Form
# 
#
#---------------------------------------------------------------------
+-------------------------------------
#!/usr/bin/perl
use strict;
use warnings;
use Tk;
use Tk::BrowseEntry;
use Tk::LabFrame;
use Tk::LabEntry;
my  $mw = MainWindow->new(-title      => "Test form ", 
        -background =>'LightBlue2');
    $mw->geometry("700x700");
    $mw->idletasks;       
$mw->minsize(700,700);
$mw->maxsize(700,700);
#---------------------------------------------------------------------
+-------------------------------------
# 
# 
#
#---------------------------------------------------------------------
+-------------------------------------
my $lbl_0 =  "Label 0";
my $lbl_1 =  "Label 1";
my $lbl_2 =  "Label 2";
my $lbl_3 = "Label 3";
    my @list_1 = ('  list 1');
    my @list_2 = ('  list 2');
    my @list_3 = ('  List 3');

my $lbl_4 = " Label 4";
    my $btn_l = "button 1";
    my $btn_2 = "button 2";
    my $btn_3 = "button3";
 
my $lbl_5 = " Label 5";
    my $btn_4 = "button 4";
    my $btn_5 = "button 5";
    my $btn_6 = "button 6"; 
   
my $lbl_6 = " Label 6";
    my $btn_7 = "button 7";
    my $btn_8 = "button 8";
    my $btn_9 = "button 9";
  
my $lbl_7 = " Label 7";   
    my $btn_10 = "button 10";
    my $btn_11 = "button 11";
   
my $lbl_8 = " Label 8";   

#---------------------------------------------------------------------
+-------------------------------------
# create top set of framesframes 
#
#---------------------------------------------------------------------
+-------------------------------------
my $top_lbl_frame = $mw->LabFrame(-label => "$lbl_0",-font => 'Times 0
+8',-background =>'LightBlue2',
                                        -labelside => "acrosstop")->pa
+ck(-side => 'top',);

my $top_frame = $top_lbl_frame->Frame( -background =>'LightBlue2')->pa
+ck(-side => 'top',);
my $bot_frame = $top_lbl_frame->Frame( -background =>'LightBlue2')->pa
+ck(-side => 'bottom',);
my $left_frame = $top_lbl_frame->Frame( -background =>'LightBlue2')->p
+ack(-side => 'left',);
my $right_frame = $top_lbl_frame->Frame( -background =>'LightBlue2')->
+pack(-side => 'right',);

#---------------------------------------------------------------------
+-------------------------------------
# Selection boxes
#
#---------------------------------------------------------------------
+-------------------------------------

my $shifts_frame = $top_frame->Frame(-background =>'LightBlue2' )->pac
+k(-side => 'top',);
my $shift_time = $shifts_frame->LabFrame(-label => "$lbl_1",-font => '
+Times 08',-background =>'LightBlue2',
                           -labelside => "acrosstop")->pack(-side => '
+left',);

my $default1 = $list_1[0];
my $Day_Night = $shift_time->BrowseEntry(-background =>'white', -varia
+ble=> \$default1)
                            ->grid(-ipadx => 10, -sticky => 'w', -colu
+mn => 1, -row => 1 );
   $Day_Night->insert('end', @list_1);

my $shift_lead = $shifts_frame->LabFrame(-label => "$lbl_2",-font => '
+Times 08',-background =>'LightBlue2',
                           -labelside => "acrosstop")->pack(-side => '
+left',);
   
my $default2 = $list_2[0];
my $Leader = $shift_lead->BrowseEntry(-background =>'white', -variable
+=> \$default2)
                            ->grid(-ipadx => 10, -sticky => 'w', -colu
+mn => 2, -row => 1 );
   $Leader->insert('end', @list_2);
 
my $shift_op = $shifts_frame->LabFrame(-label => "$lbl_3",-font => 'Ti
+mes 08',-background =>'LightBlue2',
                           -labelside => "acrosstop")->pack(-side => '
+left',); 
   
my $default3 = $list_3[0];
   $Leader = $shift_op->BrowseEntry(-background =>'white', -variable=>
+ \$default3)
                            ->grid(-ipadx => 10, -sticky => 'w', -colu
+mn => 3, -row => 1 );
   $Leader->insert('end', @list_3);
   
my $default4 = $list_3[0];
   $Leader = $shift_op->BrowseEntry(-background =>'white' , -variable=
+> \$default4)
                        ->grid(-ipadx => 10, -sticky => 'w', -column =
+> 4, -row => 1 );
   $Leader->insert('end', @list_3);  
   
my $seperator2 = $top_frame->Label( -background => "LightBlue2")->pack
+(-side => 'top');

#---------------------------------------------------------------------
+-------------------------------------
#   Tick boxes section 1
#
#---------------------------------------------------------------------
+-------------------------------------

my $frameA = $left_frame->Frame(-background =>'LightBlue2' )->pack(-si
+de => 'top',);
my $NGA = $frameA ->LabFrame(-label => "$lbl_4",-font => 'Times 08',-b
+ackground =>'LightBlue2',
                           -labelside => "acrosstop")->pack(-side => '
+left',);

my $chk1 = $NGA->Checkbutton(-text => "$btn_l", -onvalue => 1, -offval
+ue => 0,
                            -background => 'lightblue2', -activebackgr
+ound => 'lightblue2'
                            )->grid(-sticky => 'w', -column => 1, -row
+ => 1 );
my $chk2 = $NGA ->Checkbutton( -text => "$btn_2", -onvalue => 1, -offv
+alue => 0, 
                            -background => 'lightblue2', -activebackgr
+ound => 'lightblue2'
                            )->grid(-sticky => 'w', -column => 2, -row
+ => 1, );
my $chk3 = $NGA ->Checkbutton( -text => "$btn_3", -onvalue => 1, -offv
+alue => 0,
                            -background => 'lightblue2', -activebackgr
+ound => 'lightblue2'
                            )->grid(-sticky => 'w', -column => 3, -row
+ => 1, );
    
#---------------------------------------------------------------------
+-------------------------------------
# tick boxes section 2
#
#---------------------------------------------------------------------
+-------------------------------------    
my $frameB = $right_frame->Frame(-background =>'LightBlue2' )->pack(-s
+ide => 'top',);
my $XIS = $frameB->LabFrame(-label => "$lbl_5",-font => 'Times 08',-ba
+ckground =>'LightBlue2',
                           -labelside => "acrosstop")->pack(-padx => 2
+0,-side => 'left',);
        $chk1 = $XIS->Checkbutton( -text => "$btn_4", -onvalue => 1, -
+offvalue => 0, 
                            -background => 'lightblue2', -activebackgr
+ound => 'lightblue2'
                            )->grid(-sticky => 'w', -column => 1, -row
+ => 1 );
        
        $chk2 = $XIS ->Checkbutton(-text => "$btn_5 ",    -onvalue => 
+1, -offvalue => 0, -background => 'lightblue2', -activebackground => 
+'lightblue2'
                            )->grid(-sticky => 'w', -column => 2, -row
+ => 1, );
        $chk3 = $XIS ->Checkbutton(-text => "$btn_6",-onvalue => 1, -o
+ffvalue => 0, 
                            -background => 'lightblue2', -activebackgr
+ound => 'lightblue2'
                            )->grid(-sticky => 'w', -column => 3, -row
+ => 1, );

#---------------------------------------------------------------------
+-------------------------------------
# section 1 & 2 text boxes
#
#---------------------------------------------------------------------
+-------------------------------------
my $textframe1 = $left_frame->Frame(-background =>'LightBlue2' )->pack
+(-side => 'top',);
my $LBLA_txt = $textframe1->LabFrame(-background =>'LightBlue2')->pack
+(-side => 'left',);
        $LBLA_txt->Text(-width=>45, -height=>5)->grid(-sticky => 'w' )
+;        
my $textframe2 = $right_frame->Frame(-background =>'LightBlue2' )->pac
+k(-side => 'top',);    
my $LBLB_txt = $textframe2->LabFrame(-background =>'LightBlue2')->pack
+(-side => 'left',);
       $LBLB_txt->Text(-width=>45, -height=>5)->grid(-sticky => 'w' );
+    
      
#---------------------------------------------------------------------
+-------------------------------------
#tick boxes section 3
#
#---------------------------------------------------------------------
+-------------------------------------
my $frameC = $left_frame->Frame(-background =>'LightBlue2' )->pack(-si
+de => 'top',);
my $chk = $frameC ->LabFrame(-label => " $lbl_6",-font => 'Times 08',-
+background =>'LightBlue2',
                           -labelside => "acrosstop")->pack(-side => '
+left',);

   $chk1 = $chk->Checkbutton(-text => "$btn_7", -onvalue => 1, -offval
+ue => 0, 
                            -background => 'lightblue2', -activebackgr
+ound => 'lightblue2'
                            )->grid(-sticky => 'w', -column => 1, -row
+ => 1 );
   $chk2 = $chk ->Checkbutton(-text => "$btn_8", -onvalue => 1, -offva
+lue => 0, 
                            -background => 'lightblue2', -activebackgr
+ound => 'lightblue2'
                            )->grid(-sticky => 'w', -column => 2, -row
+ => 1, );
   $chk3 = $chk ->Checkbutton(-text => "$btn_9", -onvalue => 1, -offva
+lue => 0,
                            -background => 'lightblue2', -activebackgr
+ound => 'lightblue2'
                            )->grid(-sticky => 'w', -column => 3, -row
+ => 1, );
#---------------------------------------------------------------------
+-------------------------------------
#tick boxes section 4
#
#---------------------------------------------------------------------
+-------------------------------------
        
        
my $frameD = $right_frame->Frame(-background =>'LightBlue2' )->pack(-s
+ide => 'top',);
my $As4 = $frameD->LabFrame(-label => " $lbl_7",-font => 'Times 08',-b
+ackground =>'LightBlue2',
                           -labelside => "acrosstop")->pack(-side => '
+left',);

   $chk1 = $As4->Checkbutton( -text => "$btn_8", -onvalue => 1, -offva
+lue => 0, 
                            -background => 'lightblue2', -activebackgr
+ound => 'lightblue2'
                            )->grid(-sticky => 'w', -column => 1, -row
+ => 1 );
   $chk2 = $As4 ->Checkbutton(-text => "$btn_11",    -onvalue => 1, -o
+ffvalue => 0, 
                            -background => 'lightblue2', -activebackgr
+ound => 'lightblue2'
                            )->grid(-sticky => 'w', -column => 2, -row
+ => 1, );
                            
#---------------------------------------------------------------------
+-------------------------------------
# section 3 & 4 text boxes
# 
#---------------------------------------------------------------------
+-------------------------------------
    
my $textframe3 = $left_frame->Frame(-background =>'LightBlue2' )->pack
+(-side => 'top',);
my $LBLC_txt = $textframe3->LabFrame(-background =>'LightBlue2')->pack
+(-side => 'left',);
     $LBLC_txt->Text(-width=>45, -height=>5 )->grid(-sticky => 'w' ); 
+       
my $textframe4 = $right_frame->Frame(-background =>'LightBlue2' )->pac
+k(-side => 'top',);    
my $LBLD_txt = $textframe4->LabFrame(-background =>'LightBlue2')->pack
+(-side => 'left',);
     $LBLD_txt->Text(-width=>45, -height=>5 )->grid(-sticky => 'w' ); 
+   
    
my $frameE = $bot_frame->Frame(-background =>'LightBlue2' )->pack(-sid
+e => 'bottom',);

MainLoop();
[download]

Comment on perl tk how to limit the amount of text typed into a text widget Download Code

Replies are listed 'Best First'.
Re: perl tk how to limit the amount of text typed into a text widget by Anonymous Monk on Jul 24, 2015 at 01:49 UTC
I don't get it, if you're taking a screenshot , what difference does it make?	[reply]
Re^2: perl tk how to limit the amount of text typed into a text widget by john.tm (Scribe) on Jul 24, 2015 at 02:46 UTC
Hi, A screen shot will only capture what text is in the text box. So if the user types 20 lines of text, 10 lines of that text will have scrolled of the screen and won't be captured.	[reply]
Re^3: perl tk how to limit the amount of text typed into a text widget by Anonymous Monk on Jul 24, 2015 at 03:33 UTC
Hi, A screen shot will only capture what text is in the text box. So if the user types 20 lines of text, 10 lines of that text will have scrolled of the screen and won't be captured. :) Let me try a different way You say if user types 100 chars, 70 scroll off screen and only 30 are shown To solve this problem you propose to limit the amount of chars a user can type The screen shot doesn't care if 70 chars are missing because they scrolled or because the user couldn't type them up Do you see what I am saying? tk limit -> Perl/Tk,How to limit the number of characters in Entry?	[reply]
Re^4: perl tk how to limit the amount of text typed into a text widget by john.tm (Scribe) on Jul 24, 2015 at 03:41 UTC
Re^5: perl tk how to limit the amount of text typed into a text widget by Anonymous Monk on Jul 24, 2015 at 07:23 UTC