Perl Tutorial - Practical Extraction and Reporting Language (Perl)

Please leave a remark at the bottom of each page with your useful suggestion.

Perl GUI Program

Add Action Listener to Button

 #!/usr/bin/perl -w
use Tk;
$Tk::strictMotif = 1;
$main = MainWindow->new();
$button1 = $main->Button(-text => "Exit",
 -command => \&exit_button,
 -foreground => "orangered" );
$button1->pack();
$button1->configure(-background => "white" );
$button2 = $main->Button(-text => "Push Me",
 -command => \&change_color,
 -foreground => "black", 
 -background => "steelblue");
$button2->pack();
MainLoop();
sub exit_button {
 print "You pushed the button!\n";
 exit;
}
sub change_color {
 $button1->configure(-background => "red",
-foreground => "white");
 $button2->configure(-background => "maroon",
-foreground => "white",
-font => "-*-times-bold-r-normal-20-140-*");
}

Adding Action to MenuItem

 #!/usr/bin/perl -w
use Tk;
$main = MainWindow->new();
$menubar = $main->Frame(-relief=>"raised",
-borderwidth=>2);
$filebutton = $menubar->Menubutton(-text=>"File",
  -underline => 0);  # F in File
$filemenu = $filebutton->Menu();
$filebutton->configure(-menu=>$filemenu);
$filemenu->command(-command => \&open_choice,
 -label => "Open...",
 -underline => 0); # O in Open
$filemenu->separator();
$filemenu->command(-label => "Exit",
 -command => \&exit_choice,
 -underline => 1);  # "x" in Exit
$helpbutton = $menubar->Menubutton(-text=>"Help",
  -underline => 0);  # H in Help
$helpmenu = $helpbutton->Menu();
$helpmenu->command(-command => \&about_choice,
 -label => "About TkMenu...",
 -underline => 0); # A in About
$helpbutton->configure(-menu=>$helpmenu);
$filebutton->pack(-side=>"left");
$helpbutton->pack(-side=>"right");
$menubar->pack(-side=>"top", -fill=>"x");
$label = $main->Label(-text => "Main Area");
$label->pack(-side=>"top", 
 -expand=>1,
 -padx=>100, 
 -pady=>100);
MainLoop();
sub exit_choice {
 print "You chose the Exit choice!\n";
 exit;
}
sub open_choice {
 print "Open file\n";
}
sub about_choice {
 print "About tkmenu.pl\n";
}

Adding button (control) to a window

 use Tk;
my $main = MainWindow->new;
$main->Button(-text => 'End',
 -command => [$main => 'destroy']
)->pack;
MainLoop;

Adding Check Box Button to Frame

 #!/usr/bin/perl -w
use Tk;
$both_sides = "single";
$single_sides = "double";
$main = MainWindow->new();
$label = $main->Label(-text => "Print Options");
$label->pack();
$frame = $main->Frame(-relief=>"groove",
 -borderwidth=>2);
$check1 = $frame->Checkbutton(-text=>"Both Sides",
-variable=>\$both_sides,
-onvalue=>"both",
-offvalue=>"single");
$check1->pack(-side=>"top");
$check2 = $frame->Checkbutton(-text=>"Single Sides",
-variable=>\$single_sides,
-onvalue=>"both",
-offvalue=>"single");
$check2->pack(-side=>"top");
$frame->pack();
$button = $main->Button(-text => "Exit",
-command => \&exit_button);
$button->pack();
MainLoop();
sub exit_button {
 if ( $both_sides eq "both") {
  print "Print both sides.\n";
 } else {
  print "Print single-sided.\n";
 }
 if ( $single_sides eq "both") {
  print "Print both sides.\n";
 } else {
  print "Print single-sided.\n";
 } 
 exit;
}

Adding components to the Client Area of a Window with Menu Bar

 #!/usr/bin/perl -w
use Tk;
$main = MainWindow->new();
$menubar = $main->Frame(-relief=>"raised",
-borderwidth=>2);
$filebutton = $menubar->Menubutton(-text=>"File",
  -underline => 0);  # F in File
$filemenu = $filebutton->Menu();
$filebutton->configure(-menu=>$filemenu);
$filemenu->command(-command => \&open_choice,
 -label => "Open...",
 -underline => 0); # O in Open
$filemenu->separator();
$filemenu->command(-label => "Exit",
 -command => \&exit_choice,
 -underline => 1);  # "x" in Exit
$helpbutton = $menubar->Menubutton(-text=>"Help",
  -underline => 0);  # H in Help
$helpmenu = $helpbutton->Menu();
$helpmenu->command(-command => \&about_choice,
 -label => "About TkMenu...",
 -underline => 0); # A in About
$helpbutton->configure(-menu=>$helpmenu);
$filebutton->pack(-side=>"left");
$helpbutton->pack(-side=>"right");
$menubar->pack(-side=>"top", -fill=>"x");
$label = $main->Label(-text => "Main Area");
$label->pack(-side=>"top", 
 -expand=>1,
 -padx=>100, 
 -pady=>100);
MainLoop();
sub exit_choice {
 print "You chose the Exit choice!\n";
 exit;
}
sub open_choice {
 print "Open file\n";
}
sub about_choice {
 print "About tkmenu.pl\n";
}

Adding label to window

 use Tk;
my $main = MainWindow->new;
$main->Label(-text => 'Hello!'
)->pack;
MainLoop;

Adding MenuItem to Menu Bar

 #!/usr/bin/perl -w
use Tk;
$main = MainWindow->new();
$menubar = $main->Frame(-relief=>"raised",
-borderwidth=>2);
$filebutton = $menubar->Menubutton(-text=>"File",
  -underline => 0);  # F in File
$filemenu = $filebutton->Menu();
$filebutton->configure(-menu=>$filemenu);
$filemenu->command(-command => \&open_choice,
 -label => "Open...",
 -underline => 0); # O in Open
$filemenu->separator();
$filemenu->command(-label => "Exit",
 -command => \&exit_choice,
 -underline => 1);  # "x" in Exit
$helpbutton = $menubar->Menubutton(-text=>"Help",
  -underline => 0);  # H in Help
$helpmenu = $helpbutton->Menu();
$helpmenu->command(-command => \&about_choice,
 -label => "About TkMenu...",
 -underline => 0); # A in About
$helpbutton->configure(-menu=>$helpmenu);
$filebutton->pack(-side=>"left");
$helpbutton->pack(-side=>"right");
$menubar->pack(-side=>"top", -fill=>"x");
$label = $main->Label(-text => "Main Area");
$label->pack(-side=>"top", 
 -expand=>1,
 -padx=>100, 
 -pady=>100);
MainLoop();
sub exit_choice {
 print "You chose the Exit choice!\n";
 exit;
}
sub open_choice {
 # Fill in status area.
 print "Open file\n";
}
sub about_choice {
 # Fill in status area.
 print "About tkmenu.pl\n";
}

Adding radio buttom to Frame

 #!/usr/bin/perl -w
use Tk;
$quality = "letter";
$main = MainWindow->new();
$label = $main->Label(-text => "Print Options");
$label->pack();
$frame = $main->Frame(-relief=>"groove",
 -borderwidth=>2);
$radio1 = $frame->Radiobutton(-text=>"Draft",
-variable=>\$quality,
-value=>"draft");
$radio1->pack(-side=>"top");
$radio2 = $frame->Radiobutton(-text=>"Letter",
-variable=>\$quality,
-value=>"letter");
$radio2->pack(-side=>"top");
$frame->pack();
$button = $main->Button(-text => "Exit",
-command => \&exit_button);
$button->pack();
MainLoop();
sub exit_button {
 if ( $both_sides eq "both") {
  print "Print both sides.\n";
 } else {
  print "Print single-sided.\n";
 }
 
 exit;
}

Adding Separator

 #!/usr/bin/perl -w
use Tk;
$main = MainWindow->new();
$menubar = $main->Frame(-relief=>"raised",
-borderwidth=>2);
$filebutton = $menubar->Menubutton(-text=>"File",
  -underline => 0);  # F in File
$filemenu = $filebutton->Menu();
$filebutton->configure(-menu=>$filemenu);
$filemenu->command(-command => \&open_choice,
 -label => "Open...",
 -underline => 0); # O in Open
$filemenu->separator();
$filemenu->command(-label => "Exit",
 -command => \&exit_choice,
 -underline => 1);  # "x" in Exit
$helpbutton = $menubar->Menubutton(-text=>"Help",
  -underline => 0);  # H in Help
$helpmenu = $helpbutton->Menu();
$helpmenu->command(-command => \&about_choice,
 -label => "About TkMenu...",
 -underline => 0); # A in About
$helpbutton->configure(-menu=>$helpmenu);
$filebutton->pack(-side=>"left");
$helpbutton->pack(-side=>"left");
$menubar->pack(-side=>"top", -fill=>"x");
$status = $main->Label(-text=>"Status area",
  -relief=>"sunken",
  -borderwidth=>2,
  -anchor=>"w");
$status->pack(-side=>"top", -fill=>"x");
MainLoop();
sub exit_choice {
 print "You chose the Exit choice!\n";
 exit;
}
sub open_choice {
 $status->configure(-text=>"Open file.");
 print "Open file\n";
}
sub about_choice {
 $status->configure(-text=>"About program.");
 print "About tkmenu.pl\n";
}

Adding the Menu Bar to Main Window

 #!/usr/bin/perl -w
use Tk;
$main = MainWindow->new();
$menubar = $main->Frame(-relief=>"raised",
-borderwidth=>2);
$filebutton = $menubar->Menubutton(-text=>"File",
  -underline => 0);  # F in File
$filemenu = $filebutton->Menu();
$filebutton->configure(-menu=>$filemenu);
$filemenu->command(-command => \&open_choice,
 -label => "Open...",
 -underline => 0); # O in Open
$filemenu->separator();
$filemenu->command(-label => "Exit",
 -command => \&exit_choice,
 -underline => 1);  # "x" in Exit
$helpbutton = $menubar->Menubutton(-text=>"Help",
  -underline => 0);  # H in Help
$helpmenu = $helpbutton->Menu();
$helpmenu->command(-command => \&about_choice,
 -label => "About TkMenu...",
 -underline => 0); # A in About
$helpbutton->configure(-menu=>$helpmenu);
$filebutton->pack(-side=>"left");
$helpbutton->pack(-side=>"right");
$menubar->pack(-side=>"top", -fill=>"x");
$label = $main->Label(-text => "Main Area");
$label->pack(-side=>"top", 
 -expand=>1,
 -padx=>100, 
 -pady=>100);
MainLoop();
sub exit_choice {
 print "You chose the Exit choice!\n";
 exit;
}
sub open_choice {
 print "Open file\n";
}
sub about_choice {
 print "About tkmenu.pl\n";
}

Add list box to a window

 use Tk;
$main = MainWindow->new();
$listbox1 = $main->Listbox("-width" => 25, 
 "-height" => 5
)->pack;

Add scroll listener to a Scale

 use Tk;
$main = MainWindow->new();
$main->Scale('-orient'=> 'horizontal', 
 '-from' => 0,
 '-to' => 200, 
 '-tickinterval' => 40,
 '-label' => 'Select a value:', 
 '-length' => 200,
 '-variable' => \$value, 
 '-command' => \&display
)->pack;
$text1 = $main->Text ('-width'=> 40, 
 '-height' => 2
)->pack;
sub display
{
 $text1->delete('1.0','end');
 $text1->insert('end', "$value");
}
MainLoop;

Advanced Hello World program using two MainWindows

 #!/usr/local/bin/perl -w
use Tk;
use subs qw/beep/;
use strict;
my $mw1 = MainWindow->new;
my $mw2 = MainWindow->new(-screen => $ARGV[0] ||= $ENV{DISPLAY});
$mw1->Button(-text => 'Bell', -command => [\&beep, $mw1])->pack;
$mw1->Button(-text => 'Bell', -command => [\&beep, $mw2])->pack;
$mw1->Button(qw/-text Quit -command/ => \&exit)->pack;
MainLoop;
sub beep {shift->bell}

Auto-scroll entry (text field)

 #!/usr/local/bin/perl -w
use Tk;
use strict;
my $str = "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz0123456789";
my $mw = MainWindow->new;
my $lframe = $mw->Frame->pack(-fill => 'both', -side => 'left', -expand => 1);
my $entry = $mw->Entry(
 -textvariable => \$str,
 -width => 12, 
 -font => "{Comic Sans MS} 72",
 -relief => 'raised',
 -highlightthickness => 0,
)->pack(-expand => 1, -fill => 'x', -side => 'left');
my $repeat_id = $mw->repeat(300, \&shift_banner);
MainLoop;
sub shift_banner {
 my $newstr = substr($str, 1) . substr($str, 0, 1);
 $str = $newstr;
}

Bind double click action to the list box

 use Tk;
$main = MainWindow->new();
$listbox1 = $main->Listbox("-width" => 25, 
 "-height" => 5
)->pack;
$listbox1->insert('end', "Apples", "Bananas",
 "Oranges", "Pears", "Pineapples");
$listbox1->bind('<Double-1>', \&getfruit);
$text1 = $main->Text ('-width'=> 40, '-height' 
 => 2
)->pack;
sub getfruit {
 $fruit = $listbox1->get('active');
 $text1->insert('end', "$fruit ");
}
MainLoop;

Binding variable to check box

 #!/usr/local/bin/perl -w
use Tk;
use strict;
require Tk::BrowseEntry;
my $mw = MainWindow->new(-title => 'Font Viewer');
my $f = $mw->Frame->pack(-side => 'top');
my $family = 'Courier';
my $be = $f->BrowseEntry(
 -label  => "Family:", 
 -variable  => \$family, 
 -browsecmd => \&apply_font,
)->pack(-fill => 'x', -side => 'left');
$be->insert('end', sort $mw->fontFamilies);
my $size = 24;
my $bentry = $f->BrowseEntry(
 -label  => 'Size',
 -variable  => \$size, 
 -browsecmd => \&apply_font,
)->pack(-side => 'left');
$bentry->insert('end', (3 .. 32));
my $weight = "normal";
$f->Checkbutton(
 -onvalue  => "bold",
 -offvalue => "normal",
 -text  => "Weight",
 -variable => \$weight,
 -command  => \&apply_font,
)->pack(-side => 'left');
my $slant = "roman";
$f->Checkbutton(
 -onvalue => "italic",
 -offvalue => "roman", 
 -text => "Slant",
 -variable => \$slant, 
 -command => \&apply_font,
)->pack(-side => 'left');
my $underline = 0;
$f->Checkbutton(
 -text => "Underline",
 -variable => \$underline,
 -command => \&apply_font,
)->pack(-side => 'left');
my $overstrike = 0; 
$f->Checkbutton(
 -text => "Overstrike",
 -variable => \$overstrike, 
 -command => \&apply_font,
)->pack(-side => 'left');
my $stext = "www.java2s.com";
my $sample = $mw->Entry(-textvariable => \$stext)->pack(-fill => 'x');
&apply_font;
MainLoop;
sub apply_font {
 $sample->configure(-font => 
  [-family => $family,
-size => $size,
-weight => $weight,
-slant => $slant,
-underline => $underline,
-overstrike => $overstrike
  ],
 );
}

Bind mouse double click action to a Text control

 use Tk;
$main = MainWindow->new();
$main->Button( -text => "Click Me!",
 -command => \&display
)->pack(-side => "left");
$text1 = $main->Text ('-width'=> 40, '-height' => 2
)->pack;
$text1->bind('<Double-1>', \&display);
sub display
{
 $text1->insert('end', "Hello!");
}
MainLoop;

Bind variable to a Scale

 use Tk;
$main = MainWindow->new();
$main->Scale('-orient'=> 'horizontal', 
 '-from' => 0,
 '-to' => 200, 
 '-tickinterval' => 40,
 '-label' => 'Select a value:', 
 '-length' => 200,
 '-variable' => \$value, 
 '-command' => \&display
)->pack;
$text1 = $main->Text ('-width'=> 40, 
 '-height' => 2
)->pack;
sub display
{
 $text1->delete('1.0','end');
 $text1->insert('end', "$value");
}
MainLoop;

Build a list of Check Box by using the value in an array

 #!/usr/local/bin/perl -w
use Tk;
use strict;
my $mw = MainWindow->new(-title => 'My List');
foreach (qw/A B C D/) {
 $mw->Checkbutton(-text => $_)->pack(-side => 'left');
}
$mw->Button(-text => "Purchase")->pack(-side => 'bottom');
MainLoop;

Build menu items for main windows

 use Tk;
my $main = MainWindow->new();
$menubar = $main->Frame()->pack('-side' => 'top', '-fill' => 'x');
$filemenu = $menubar->Menubutton('-text' => 'File')->pack('-side' => 'left');
$filemenu->command('-label' => 'Open', '-command' => sub
 {$text->delete('1.0', 'end');
 $text->insert('end', "You clicked open.");});
$filemenu->separator();
$filemenu->command('-label' => 'Exit', '-command' => sub {exit});
$editmenu = $menubar->Menubutton('-text' => 'Edit')->pack('-side' => 'left');
$editmenu->command('-label' => 'Search', '-command' => sub
 {$text->delete('1.0', 'end');
 $text->insert('end', "You clicked search.");});
$editmenu->command('-label' => 'Replace', '-command' => sub
 {$text->delete('1.0', 'end');
 $text->insert('end', "You clicked replace.");});
$text = $main->Text ('-width' => 40, '-height' => 3)->pack();
MainLoop;

Call Text insert function to add text to a Text control

 use Tk;
$main = MainWindow->new();
$main->Button( -text => "Click Me!",
-command => \&display
)->pack;
$text1 = $main->Text ('-width'=> 40, '-height' => 2
)->pack;
sub display
{
 $text1->insert('end', "Hello!");
}
MainLoop;

Change Button Background Color in Button Action

 #!/usr/bin/perl -w
use Tk;
$Tk::strictMotif = 1;
$main = MainWindow->new();
$button1 = $main->Button(-text => "Exit",
 -command => \&exit_button,
 -foreground => "orangered" );
$button1->pack();
$button1->configure(-background => "white" );
$button2 = $main->Button(-text => "Push Me",
 -command => \&change_color,
 -foreground => "black", 
 -background => "steelblue");
$button2->pack();
MainLoop();
sub exit_button {
 print "You pushed the button!\n";
 exit;
}
sub change_color {
 $button1->configure(-background => "red",
-foreground => "white");
 $button2->configure(-background => "maroon",
-foreground => "white",
-font => "-*-times-bold-r-normal-20-140-*");
}

Change font of entry (text field)

 #!/usr/local/bin/perl -w
use Tk;
use strict;
require Tk::BrowseEntry;
my $mw = MainWindow->new(-title => 'Font Viewer');
my $f = $mw->Frame->pack(-side => 'top');
my $family = 'Courier';
my $be = $f->BrowseEntry(
 -label  => "Family:", 
 -variable  => \$family, 
 -browsecmd => \&apply_font,
)->pack(-fill => 'x', -side => 'left');
$be->insert('end', sort $mw->fontFamilies);
my $size = 24;
my $bentry = $f->BrowseEntry(
 -label  => 'Size',
 -variable  => \$size, 
 -browsecmd => \&apply_font,
)->pack(-side => 'left');
$bentry->insert('end', (3 .. 32));
my $weight = "normal";
$f->Checkbutton(
 -onvalue  => "bold",
 -offvalue => "normal",
 -text  => "Weight",
 -variable => \$weight,
 -command  => \&apply_font,
)->pack(-side => 'left');
my $slant = "roman";
$f->Checkbutton(
 -onvalue => "italic",
 -offvalue => "roman", 
 -text => "Slant",
 -variable => \$slant, 
 -command => \&apply_font,
)->pack(-side => 'left');
my $underline = 0;
$f->Checkbutton(
 -text => "Underline",
 -variable => \$underline,
 -command => \&apply_font,
)->pack(-side => 'left');
my $overstrike = 0; 
$f->Checkbutton(
 -text => "Overstrike",
 -variable => \$overstrike, 
 -command => \&apply_font,
)->pack(-side => 'left');
my $stext = "www.java2s.com";
my $sample = $mw->Entry(-textvariable => \$stext)->pack(-fill => 'x');
&apply_font;
MainLoop;
sub apply_font {
 $sample->configure(-font => 
  [-family => $family,
-size => $size,
-weight => $weight,
-slant => $slant,
-underline => $underline,
-overstrike => $overstrike
  ],
 );
}

Change text in a Text (TextField) in radio button and checkbox button action

 use Tk;
$main = MainWindow->new();
$main->Radiobutton( -text => "Radio 1",
 -command => sub{
 $text1->delete('1.0', 'end');
 $text1->insert('end', "You clicked radio 1");}
)->pack;
$main->Radiobutton( -text => "Radio 2",
 -value => "0",
 -command => sub{
 $text1->delete('1.0', 'end');
 $text1->insert('end', "You clicked radio 2");
 }
)->pack;
$main->Checkbutton( -text => "Check 1",
 -command => sub{
 $text1->delete('1.0', 'end');
 $text1->insert('end', "You clicked check 1");
 }
)->pack;
$main->Checkbutton( -text => "Check 2",
 -command => sub{
 $text1->delete('1.0', 'end');
 $text1->insert('end', "You clicked check 2");
 }
)->pack;
$text1 = $main->Text ('-width'=> 40, '-height' => 2)->pack;
MainLoop;

Change the Button Font

 #!/usr/bin/perl -w
use Tk;
$Tk::strictMotif = 1;
$main = MainWindow->new();
$button1 = $main->Button(-text => "Exit",
 -command => \&exit_button,
 -foreground => "orangered" );
$button1->pack();
$button1->configure(-background => "white" );
$button2 = $main->Button(-text => "Push Me",
 -command => \&change_color,
 -foreground => "black", 
 -background => "steelblue");
$button2->pack();
MainLoop();
sub exit_button {
 print "You pushed the button!\n";
 exit;
}
sub change_color {
 $button1->configure(-background => "red",
-foreground => "white");
 $button2->configure(-background => "maroon",
-foreground => "white",
-font => "-*-times-bold-r-normal-20-140-*");
}

Changing Attributes in a Perl/Tk interface

 #!/usr/bin/perl -w
use Tk;
$Tk::strictMotif = 1;
$main = MainWindow->new();
$button1 = $main->Button(-text => "Exit",
 -command => \&exit_button,
 -foreground => "orangered" );
$button1->pack();
$button1->configure(-background => "white" );
$button2 = $main->Button(-text => "Push Me",
 -command => \&change_color,
 -foreground => "black", 
 -background => "steelblue");
$button2->pack();
MainLoop();
sub exit_button {
 print "You pushed the button!\n";
 exit;
}
sub change_color {
 $button1->configure(-background => "red",
-foreground => "white");
 $button2->configure(-background => "maroon",
-foreground => "white",
-font => "-*-times-bold-r-normal-20-140-*");
}

CheckBox Menu

 use Tk; 

my $main = MainWindow->new;  
my $menubar = $main->Frame;
$menubar->pack(-fill => 'x');
my $filemenu = $menubar->Menubutton(-text => 'File');
$filemenu->command(
 -label => 'Open', 
 -command  => sub {$text1->insert('1.0', "You chose open.\n")},
 -accelerator => 'Ctrl+O',
);
$main->bind('<Control-o>' => sub {$text1->insert('1.0', "You chose open.\n")});
$filemenu->cascade(-label => 'Check buttons');
$filemenu->cascade(-label => 'Radio buttons');
my $checkcascade = $filemenu->cget(-menu); 
my $checkmenu = $checkcascade->Menu;
$filemenu->entryconfigure('Check buttons', -menu => $checkmenu);
$checkmenu->checkbutton(-label => 'Check 1', -variable => \$check1,
 -command => sub {$text1->insert('1.0', "You chose check 1.\n")});
$checkmenu->checkbutton(-label => 'Check 2', -variable => \$check2,
 -command => sub {$text1->insert('1.0', "You chose check 2.\n")});
$checkmenu->checkbutton(-label => 'Check 8', -variable => \$check8,
 -command => sub {$text1->insert('1.0', "You chose check 8.\n")});
my $radiocascade = $filemenu->cget(-menu); 
my $radiomenu = $radiocascade->Menu;
$filemenu->entryconfigure('Radio buttons', -menu => $radiomenu);
$radiomenu->radiobutton(-label => 'Radio 1', -variable => \$radio1,
 -command => sub {$text1->insert('1.0', "You chose radio 1.\n")});
$radiomenu->radiobutton(-label => 'Radio 2', -variable => \$radio1,
 -command => sub {$text1->insert('1.0', "You chose radio 2.\n")});
$radiomenu->separator;
$radiomenu->radiobutton(-label => 'Radio 5', -variable => \$radio2,
 -command => sub {$text1->insert('1.0', "You chose radio 5.\n")});
$radiomenu->radiobutton(-label => 'Radio 6', -variable => \$radio2,
 -command => sub {$text1->insert('1.0', "You chose radio 6.\n")});
$radiomenu->separator;
$filemenu->command('-label' => 'Exit', '-command' => sub {exit});
$filemenu->pack(-side => 'left');
$editmenu = $menubar->Menubutton('-text' => 'Edit')->pack('-side' => 
'left');
$editmenu->command(-label => 'Search', 
 -background => "red",
 -command => sub
 {$text1->delete('1.0', 'end');
 $text1->insert('end', "You chose search.");});
$editmenu->command(-label => 'Replace', 
 -background => "orange",
 -command => sub
 {$text1->delete('1.0', 'end');
 $text1->insert('end', "You chose replace.");});
$editmenu->command(-label => 'Find', 
 -background => "yellow",
 -command => sub
 {$text1->delete('1.0', 'end');
 $text1->insert('end', "You chose find.");});
$editmenu->pack(-side => 'left');
$text1 = $main->Text;
$text1->pack(-fill => 'both');
MainLoop;

Check 'Check Box Button' Selection Value

 #!/usr/bin/perl -w
use Tk;
$both_sides = "single";
$single_sides = "double";
$main = MainWindow->new();
$label = $main->Label(-text => "Print Options");
$label->pack();
$frame = $main->Frame(-relief=>"groove",
 -borderwidth=>2);
$check1 = $frame->Checkbutton(-text=>"Both Sides",
-variable=>\$both_sides,
-onvalue=>"both",
-offvalue=>"single");
$check1->pack(-side=>"top");
$check2 = $frame->Checkbutton(-text=>"Single Sides",
-variable=>\$single_sides,
-onvalue=>"both",
-offvalue=>"single");
$check2->pack(-side=>"top");
$frame->pack();
$button = $main->Button(-text => "Exit",
-command => \&exit_button);
$button->pack();
MainLoop();
sub exit_button {
 if ( $both_sides eq "both") {
  print "Print both sides.\n";
 } else {
  print "Print single-sided.\n";
 }
 if ( $single_sides eq "both") {
  print "Print both sides.\n";
 } else {
  print "Print single-sided.\n";
 } 
 exit;
}

Choose color dialog

 #!/usr/bin/perl -w
use Tk;
$Tk::strictMotif = 1;
$main = MainWindow->new();
$button1 = $main->Button(-text => "Exit",
 -command => \&exit_button,
 -foreground => "orangered" );
$button1->pack();
$button1->configure(-background => "white" );
$button2 = $main->Button(-text => "Choose Color",
 -command => \&change_color,
 -foreground => "black", 
 -background => "steelblue");
$button2->pack();
MainLoop();
sub exit_button {
 print "You pushed the button!\n";
 exit;
}
sub change_color {
 my($color) = $button2->chooseColor(-initialcolor => "maroon" );
 
 if ($color ne "") {
  print "New color is $color\n";
 
  $button2->configure(-background => $color,
 -foreground => "white",
 -font => "-*-times-bold-r-normal-20-140-*");
 }
}

Configure a Text Widget

 #!/usr/local/bin/perl -w
use Tk;
use strict;
my $mw = MainWindow->new;
my $t = $mw->Text()->pack();
$t->tagConfigure('bold',  -font => "{Courier New} 24 {bold}");
$t->insert('end', "This is some normal text\n");
MainLoop;

Control the fill

 use Tk;
require Tk::BrowseEntry;
$numWidgets = 1;
my (@packdirs) = ();
my (@anchordirs) = ();
my (@fill) = ();
my (@expand) = ();
$mw = MainWindow->new(-title => "This is the title");
$f = $mw->Frame(-borderwidth => 1, 
 -relief => 'groove')
 ->pack(-side => 'top', 
 -fill => 'x');
$top = $mw->Toplevel(-title => "output window");
my $addbutton = $f->Button(-text => "Add Widget", 
-command => \&addwidget )->pack(-anchor => 'center');
foreach (0..$numWidgets) {
  my $b = $top->Button(-text => $_ . ": $packdirs[$_]")->pack;
  my %pinfo = $b->packInfo;
  $b->packForget;
  &addwidget($_);  
}
MainLoop;
sub repack {
  @w = $top->packSlaves;
  foreach (@w) { $_->packForget; }
  my $e = 0;
  foreach (@w){
 $_->configure(-text => "$e: $packdirs[$e]");
 $_->pack(-side => $packdirs[$e], 
 -fill => $fill[$e], 
 -expand => $expand[$e], 
 -anchor => $anchordirs[$e]);
 $e++;
  }
}
sub addwidget {
  my ($count) = @_;
  if (! defined $count){
 $numWidgets ++;
 $count = $numWidgets ;
  }
  
  $packdirs[$count] = 'top';
  $anchordirs[$count] = 'center';
  $fill[$count] = 'none';
  $expand[$count] = 0;
  
  my $f1 = $f->Frame->pack(-side => 'top', -expand => 1, 
 -fill =>'y', -before => $addbutton);
  $f1->BrowseEntry(-label => "-fill", -choices => [qw/none x y both/], 
 -variable => \$fill[$count], -browsecmd => \&repack)
 ->pack(-ipady => 5, -side => 'left');
  $top->Button(-text => $count . ": $packdirs[$count]",
 -font => "Courier 20 bold")->pack(-side => $packdirs[$count], 
 -fill => $fill[$count], -expand => $expand[$count]);
}

Create a scrolled Text widget

 #!/usr/bin/perl -w
use Tk;
$main = MainWindow->new();
$menubar = $main->Frame(-relief => "raised",
-borderwidth => 2);
$filebutton = $menubar->Menubutton(-text => "File",
  -underline => 0);  # F in File
$filemenu = $filebutton->Menu();
$filebutton->configure(-menu=>$filemenu);
$filemenu->command(-command => \&open_choice,
 -label  => "Open...",
 -underline => 0); # O in Open
$filemenu->command(-command => \&dump_choice,
 -label  => "Print",
 -underline => 0); # P in Print
$filemenu->command(-label => "Exit",
 -command=> \&exit_choice,
 -underline => 1);  # "x" in Exit
$filebutton->pack(-side=>"left");
$menubar->pack(-side=>"top", -fill=>"x");
$text = $main->Scrolled('Text',
-relief=> "sunken",
-borderwidth => 2,
-setgrid  => "true",
-scrollbars  => 'se' );
  
$text->insert("1.0","this is a test.");
$text->pack(-side=>"top", 
-expand => 1,
-fill=> 'both');
MainLoop();
sub exit_choice {
 print "You chose the Exit choice!\n";
 exit;
}
sub open_choice {
 $status->configure(-text=>"Open file.");
 print "Open file\n";
}
sub dump_choice {
 $status->configure(-text=>"Dumping text...");
 print $text->get("1.0", "end");
}

Create a Status Bar based on Label

 #!/usr/bin/perl -w
use Tk;
$main = MainWindow->new();
$menubar = $main->Frame(-relief=>"raised",
-borderwidth=>2);
$filebutton = $menubar->Menubutton(-text=>"File",
  -underline => 0);  # F in File
$filemenu = $filebutton->Menu();
$filebutton->configure(-menu=>$filemenu);
$filemenu->command(-command => \&open_choice,
 -label => "Open...",
 -underline => 0); # O in Open
$filemenu->separator();
$filemenu->command(-label => "Exit",
 -command => \&exit_choice,
 -underline => 1);  # "x" in Exit
$helpbutton = $menubar->Menubutton(-text=>"Help",
  -underline => 0);  # H in Help
$helpmenu = $helpbutton->Menu();
$helpmenu->command(-command => \&about_choice,
 -label => "About TkMenu...",
 -underline => 0); # A in About
$helpbutton->configure(-menu=>$helpmenu);
$filebutton->pack(-side=>"left");
$helpbutton->pack(-side=>"left");
$menubar->pack(-side=>"top", -fill=>"x");
$status = $main->Label(-text=>"Status area",
  -relief=>"sunken",
  -borderwidth=>2,
  -anchor=>"w");
$status->pack(-side=>"top", -fill=>"x");
MainLoop();
sub exit_choice {
 print "You chose the Exit choice!\n";
 exit;
}
sub open_choice {
 $status->configure(-text=>"Open file.");
 print "Open file\n";
}
sub about_choice {
 $status->configure(-text=>"About program.");
 print "About tkmenu.pl\n";
}

Create CheckBox button

 use Tk;
$main = MainWindow->new();
$main->Radiobutton( -text => "Radio 1",
 -command => sub{
 $text1->delete('1.0', 'end');
 $text1->insert('end', "You clicked radio 1");}
)->pack;
$main->Radiobutton( -text => "Radio 2",
 -value => "0",
 -command => sub{
 $text1->delete('1.0', 'end');
 $text1->insert('end', "You clicked radio 2");
 }
)->pack;
$main->Checkbutton( -text => "Check 1",
 -variable => $check1,
 -command => sub{
 $text1->delete('1.0', 'end');
 $text1->insert('end', "You clicked check 1 $check1");
 }
)->pack;
$main->Checkbutton( -text => "Check 2",
 -command => sub{
 $text1->delete('1.0', 'end');
 $text1->insert('end', "You clicked check 2");
 }
)->pack;
$text1 = $main->Text ('-width'=> 40, '-height' => 2)->pack;
MainLoop;

Create empty window

 use Tk;  
my $main = MainWindow->new;
MainLoop;

Create Oval

 use Tk;
$main = MainWindow->new;
$canvas1 = $main->Canvas('-width' => 400,
 -height => 200
)->pack;
$canvas1->create ('oval', '50', '50', '160',
 '160', -fill => 'red');
MainLoop;

Create Polygon

 use Tk;
$main = MainWindow->new;
$canvas1 = $main->Canvas('-width' => 400,
 -height => 200
)->pack;
$canvas1->create ('polygon', '85', '105', '105',
 '85', '125', '105', '105', '125', '85', '105', 
 -fill => 'black');
MainLoop;

Create RadioButton

 use Tk;
$main = MainWindow->new();
$main->Radiobutton( -text => "Radio 1",
 -command => sub{
 $text1->delete('1.0', 'end');
 $text1->insert('end', "You clicked radio 1");}
)->pack;
$main->Radiobutton( -text => "Radio 2",
 -value => "0",
 -command => sub{
 $text1->delete('1.0', 'end');
 $text1->insert('end', "You clicked radio 2");
 }
)->pack;
$main->Checkbutton( -text => "Check 1",
 -variable => $check1,
 -command => sub{
 $text1->delete('1.0', 'end');
 $text1->insert('end', "You clicked check 1 $check1");
 }
)->pack;
$main->Checkbutton( -text => "Check 2",
 -command => sub{
 $text1->delete('1.0', 'end');
 $text1->insert('end', "You clicked check 2");
 }
)->pack;
$text1 = $main->Text ('-width'=> 40, '-height' => 2)->pack;
MainLoop;

Create Rectangle

 use Tk;
$main = MainWindow->new;
$canvas1 = $main->Canvas('-width' => 400,
 -height => 200
)->pack;
$canvas1->create ('rectangle', '250', '50', '360',
 '160', -fill => 'blue');
MainLoop;

Create two windows

 use Tk;
require Tk::BrowseEntry;
$numWidgets = 10;
$mw = MainWindow->new(-title => "Play w/pack");
$f = $mw->Frame(-borderwidth => 1, 
 -relief => 'groove')
 ->pack(-side => 'top', 
 -fill => 'x');
my (@packdirs) = ();
$i = 0;
foreach (0..$numWidgets)
{
  $packdirs[$_] = 'top';
  my $be = $f->BrowseEntry(-label => "Widget $_:", 
 -choices => ["right", "left", "top", "bottom"], 
 -variable => \$packdirs[$_], -browsecmd => \&repack)
 ->pack(-ipady => 5);
}
$f->Button(-text => "Repack", 
  -command => \&repack )
->pack(-anchor => 'center');
$top = $mw->Toplevel(-title => "output window");
my $c;
foreach (@packdirs)
{
  my $b = $top->Button(-text => $c++ . ": $_")
->pack(-side => $_, -fill => 'both', -expand => 1);
}
MainLoop;
sub repack
{
  @w = $top->packSlaves;
  foreach (@w) { $_->packForget; }
  my $e = 0;
  foreach (@w)
  {
 $_->configure(-text => "$e: $packdirs[$e]");
 $_->pack(-side => $packdirs[$e++], -fill => 'both', -expand => 1);
  }
}

Destroy a window in button action

 use Tk;
my $main = MainWindow->new;
$main->Button(-text => 'End',
 -command => [$main => 'destroy']
)->pack;
MainLoop;

Draw image on a canvas

 use Tk;
my $main = MainWindow->new;
$canvas = $main->Canvas('-width' => 330,
 -height => 90); 
$main->Photo('image1', 
 -file => 'image.gif');
$canvas->createImage(0, 0, 
 -anchor => 'nw',
 -image => image1);
$canvas->pack;
MainLoop;

Draw line

 use Tk;
$main = MainWindow->new;
$canvas1 = $main->Canvas('-width' => 400,
 -height => 200
)->pack;
$canvas1->create ('line', '105', '105', '305',
 '105');
MainLoop;

Each check button has its own variable

 #!/usr/bin/perl -w
use Tk;
$both_sides = "single";
$single_sides = "double";
$main = MainWindow->new();
$label = $main->Label(-text => "Print Options");
$label->pack();
$frame = $main->Frame(-relief=>"groove",
 -borderwidth=>2);
$check1 = $frame->Checkbutton(-text=>"Both Sides",
-variable=>\$both_sides,
-onvalue=>"both",
-offvalue=>"single");
$check1->pack(-side=>"top");
$check2 = $frame->Checkbutton(-text=>"Single Sides",
-variable=>\$single_sides,
-onvalue=>"both",
-offvalue=>"single");
$check2->pack(-side=>"top");
$frame->pack();
$button = $main->Button(-text => "Exit",
-command => \&exit_button);
$button->pack();
MainLoop();
sub exit_button {
 if ( $both_sides eq "both") {
  print "Print both sides.\n";
 } else {
  print "Print single-sided.\n";
 }
 if ( $single_sides eq "both") {
  print "Print both sides.\n";
 } else {
  print "Print single-sided.\n";
 } 
 exit;
}

Each radio button shares the same variable

 #!/usr/bin/perl -w
use Tk;
$quality = "letter";
$main = MainWindow->new();
$label = $main->Label(-text => "Print Options");
$label->pack();
$frame = $main->Frame(-relief=>"groove",
 -borderwidth=>2);
$radio1 = $frame->Radiobutton(-text=>"Draft",
-variable=>\$quality,
-value=>"draft");
$radio1->pack(-side=>"top");
$radio2 = $frame->Radiobutton(-text=>"Letter",
-variable=>\$quality,
-value=>"letter");
$radio2->pack(-side=>"top");
$frame->pack();
$button = $main->Button(-text => "Exit",
-command => \&exit_button);
$button->pack();
MainLoop();
sub exit_button {
 if ( $both_sides eq "both") {
  print "Print both sides.\n";
 } else {
  print "Print single-sided.\n";
 }
 exit;
}

Embeded controls

 #!/usr/local/bin/perl -w
use Tk;
use strict;
my %info;
my $mw = MainWindow->new;
$mw->title("Data Entry");
my $f = $mw->Frame->pack(-side => 'bottom');
my $t = $mw->Scrolled("Text", -width => 40, 
 -wrap => 'none')->pack(-expand => 1, -fill => 'both');
foreach (qw/A B C D E F G H I_J L_O/) {
 my $w = $t->Label(-text => "$_:", -relief => 'groove', -width => 20);
 $t->windowCreate('end', -window => $w);
 $w = $t->Entry(-width => 20, -textvariable => \$info{$_});
 $t->windowCreate('end', -window => $w);
 $t->insert('end', "\n");
}
$t->configure(-state => 'disabled'); # disallows user typing
MainLoop;

Entry(text field): set font

 #!/usr/local/bin/perl -w
use Tk;
use strict;
my $str = "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz0123456789";
my $mw = MainWindow->new;
my $lframe = $mw->Frame->pack(-fill => 'both', -side => 'left', -expand => 1);
my $lb = $lframe->Scrolled(qw/Listbox -scrollbars e -height 3/)->
  pack(qw/-fill both -expand 1 -side top/);
$lb->insert('end', sort $mw->fontFamilies);
my $entry = $mw->Entry(
 -textvariable => \$str,
 -width => 12, 
 -font => "{Comic Sans MS} 72",
 -relief => 'raised',
 -highlightthickness => 0,
)->pack(-expand => 1, -fill => 'x', -side => 'left');
$lb->bind("<Button>", sub { $entry->configure(-font =>
 "{". $lb->get($lb->curselection) . "} 72"); });
MainLoop;

Entry(text field): Set highlightthickness

 #!/usr/local/bin/perl -w
use Tk;
use strict;
my $str = "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz0123456789";
my $mw = MainWindow->new;
my $lframe = $mw->Frame->pack(-fill => 'both', -side => 'left', -expand => 1);
my $lb = $lframe->Scrolled(qw/Listbox -scrollbars e -height 3/)->
  pack(qw/-fill both -expand 1 -side top/);
$lb->insert('end', sort $mw->fontFamilies);
my $entry = $mw->Entry(
 -textvariable => \$str,
 -width => 12, 
 -font => "{Comic Sans MS} 72",
 -relief => 'raised',
 -highlightthickness => 0,
)->pack(-expand => 1, -fill => 'x', -side => 'left');
$lb->bind("<Button>", sub { $entry->configure(-font =>
 "{". $lb->get($lb->curselection) . "} 72"); });
MainLoop;

Exit an Application with 'exit' Command

 #!/usr/bin/perl -w
use Tk;
$Tk::strictMotif = 1;
$main = MainWindow->new();
$button1 = $main->Button(-text => "Exit",
 -command => \&exit_button,
 -foreground => "orangered" );
$button1->pack();
$button1->configure(-background => "white" );
$button2 = $main->Button(-text => "Push Me",
 -command => \&change_color,
 -foreground => "black", 
 -background => "steelblue");
$button2->pack();
MainLoop();
sub exit_button {
 print "You pushed the button!\n";
 exit;
}
sub change_color {
 $button1->configure(-background => "red",
-foreground => "white");
 $button2->configure(-background => "maroon",
-foreground => "white",
-font => "-*-times-bold-r-normal-20-140-*");
}

Fill data to a list box

 #!/usr/local/bin/perl -w
use Tk;
use strict;
my $str = "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz0123456789";
my $mw = MainWindow->new;
my $lframe = $mw->Frame->pack(-fill => 'both', -side => 'left', -expand => 1);
my $lb = $lframe->Scrolled(qw/Listbox -scrollbars e -height 3/)->
  pack(qw/-fill both -expand 1 -side top/);
$lb->insert('end', sort $mw->fontFamilies);
my $entry = $mw->Entry(
 -textvariable => \$str,
 -width => 12, 
 -font => "{Comic Sans MS} 72",
 -relief => 'raised',
 -highlightthickness => 0,
)->pack(-expand => 1, -fill => 'x', -side => 'left');
$lb->bind("<Button>", sub { $entry->configure(-font =>
 "{". $lb->get($lb->curselection) . "} 72"); });
MainLoop;

Fill the Entry (text field): textvariable

 #!/usr/local/bin/perl -w
use Tk;
use strict;
my $str = "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz0123456789";
my $mw = MainWindow->new;
my $lframe = $mw->Frame->pack(-fill => 'both', -side => 'left', -expand => 1);
my $lb = $lframe->Scrolled(qw/Listbox -scrollbars e -height 3/)->
  pack(qw/-fill both -expand 1 -side top/);
$lb->insert('end', sort $mw->fontFamilies);
my $entry = $mw->Entry(
 -textvariable => \$str,
 -width => 12, 
 -font => "{Comic Sans MS} 72",
 -relief => 'raised',
 -highlightthickness => 0,
)->pack(-expand => 1, -fill => 'x', -side => 'left');
$lb->bind("<Button>", sub { $entry->configure(-font =>
 "{". $lb->get($lb->curselection) . "} 72"); });
MainLoop;

Get font family from mainwindows

 #!/usr/local/bin/perl -w
use Tk;
use strict;
my $str = "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz0123456789";
my $mw = MainWindow->new;
my $lframe = $mw->Frame->pack(-fill => 'both', -side => 'left', -expand => 1);
my $lb = $lframe->Scrolled(qw/Listbox -scrollbars e -height 3/)->
  pack(qw/-fill both -expand 1 -side top/);
$lb->insert('end', sort $mw->fontFamilies);
my $entry = $mw->Entry(
 -textvariable => \$str,
 -width => 12, 
 -font => "{Comic Sans MS} 72",
 -relief => 'raised',
 -highlightthickness => 0,
)->pack(-expand => 1, -fill => 'x', -side => 'left');
$lb->bind("<Button>", sub { $entry->configure(-font =>
 "{". $lb->get($lb->curselection) . "} 72"); });
MainLoop;

Get selected Color from Color Chooser Dialog

 #!/usr/bin/perl -w
use Tk;
$Tk::strictMotif = 1;
$main = MainWindow->new();
$button1 = $main->Button(-text => "Exit",
 -command => \&exit_button,
 -foreground => "orangered" );
$button1->pack();
$button1->configure(-background => "white" );
$button2 = $main->Button(-text => "Choose Color",
 -command => \&change_color,
 -foreground => "black", 
 -background => "steelblue");
$button2->pack();
MainLoop();
sub exit_button {
 print "You pushed the button!\n";
 exit;
}
sub change_color {
 my($color) = $button2->chooseColor(-initialcolor => "maroon" );
 
 if ($color ne "") {
  print "New color is $color\n";
 
  $button2->configure(-background => $color,
 -foreground => "white",
 -font => "-*-times-bold-r-normal-20-140-*");
 }
}

Get selected File from File Dialog

 #!/usr/bin/perl -w
use Tk;
use Tk::FileSelect;
$main = MainWindow->new();
$menubar = $main->Frame(-relief=>"raised",
-borderwidth=>2);
$filebutton = $menubar->Menubutton(-text=>"File",
  -underline => 0);  # F in File
$filemenu = $filebutton->Menu();
$filebutton->configure(-menu=>$filemenu);
$filemenu->command(-command => \&open_choice,
 -label => "Open...",
 -underline => 0); # O in Open
$filemenu->command(-command => \&dump_choice,
 -label => "Dump",
 -underline => 0); # D in Dump
$filemenu->separator();
$filemenu->command(-label => "Exit",
 -command => \&exit_choice,
 -underline => 1);  # "x" in Exit
$filebutton->pack(-side=>"left");
$menubar->pack(-side=>"top", -fill=>"x");
$text = $main->Scrolled('Text',
-relief=> "sunken",
-borderwidth => 2,
-setgrid  => "true",
-scrollbars  => 'se' );
$text->pack(-side=>"top", 
-expand => 1,
-fill => 'both');
$file_dialog = $main->FileSelect(-directory => ".");
MainLoop();
sub exit_choice {
 print "You chose the Exit choice!\n";
 exit;
}
sub open_choice {
 $filename = $file_dialog->Show();
 
 if ($filename ne "" ) {
  open (FILE, $filename);
  # Clear Text widget.
  $text->delete("1.0", "end");
  while ($txt = <FILE>) {
$text->insert("end", $txt);
  }
  close(FILE);
 }
}
sub dump_choice {
 print $text->get("1.0", "end");
}

Get text input in a single line Text Box

 #!/usr/bin/perl -w
use Tk;
$main = MainWindow->new();
$label = $main->Label(-text=>"Enter user name:");
$label->pack(-side=>"left");
$entry = $main->Entry();
$entry->bind("<Return>", \&handle_return );
$entry->pack(-side=>"left");
MainLoop();
sub handle_return {
 $txt = $entry->get();
 print "You entered $txt\n";
 exit;
}

Hide and show control

 #!/usr/local/bin/perl -w
use Tk;
use strict;
my $str = "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz0123456789";
my $mw = MainWindow->new;
my $lframe = $mw->Frame->pack(-fill => 'both', -side => 'left', -expand => 1);
my $lb = $lframe->Scrolled(qw/Listbox -scrollbars e -height 3/)->
  pack(qw/-fill both -expand 1 -side top/);
$lb->insert('end', sort $mw->fontFamilies);
my $hidebutton = $mw->Button(-text => ">");
$hidebutton->pack(-side => 'left', -fill => 'y');
$hidebutton->configure(
 -command => sub { 
  if ($hidebutton->cget(-text) eq ">") {
$lframe->packForget; $hidebutton->configure(-text => "<")
  } else {
$lframe->pack(-before => $hidebutton, -fill => 'both',
  -side => 'left', -expand => 1); 
$hidebutton->configure(-text => ">");
  }
 },
 -font => "courier 8",
);
my $entry = $mw->Entry(
 -textvariable => \$str,
)->pack(-expand => 1, -fill => 'x', -side => 'left');
$lb->bind("<Button>", sub { $entry->configure(-font =>
 "{". $lb->get($lb->curselection) . "} 72"); });
MainLoop;
# Causes text to be wrapped around.
sub shift_banner {
 my $newstr = substr($str, 1) . substr($str, 0, 1);
 $str = $newstr;
}

Insert bold text to a Text widget

 #!/usr/local/bin/perl -w
use Tk;
use strict;
my $mw = MainWindow->new;
my $t = $mw->Text()->pack();
$t->tagConfigure('bold',  -font => "{Courier New} 24 {bold}");
$t->insert('end', "This is some normal text\n");
$t->insert('end', "This is some bold text\n", 'bold');
MainLoop;

Insert text string to a Text Widget

 #!/usr/local/bin/perl -w
use Tk;
use strict;
my $mw = MainWindow->new;
my $t = $mw->Text()->pack();
$t->tagConfigure('bold',  -font => "{Courier New} 24 {bold}");
$t->insert('end', "This is some normal text\n");
MainLoop;

Insert text to a Text control (TextField)

 use Tk;
my $main = MainWindow->new;
my $entry1 = $main->Entry->pack;
$entry1->insert(
 0,
 'Here is some long text that you have to scroll to see.'
);
MainLoop;

Insert value to list box

 use Tk;
$main = MainWindow->new();
$listbox1 = $main->Listbox("-width" => 25, 
 "-height" => 5
)->pack;
$listbox1->insert('end', "Apples", "Bananas",
 "Oranges", "Pears", "Pineapples");
$listbox1->bind('<Double-1>', \&getfruit);
$text1 = $main->Text ('-width'=> 40, '-height' 
 => 2
)->pack;
sub getfruit {
 $fruit = $listbox1->get('active');
 $text1->insert('end', "$fruit ");
}
MainLoop;

Layout control: fill

 #!/usr/local/bin/perl -w
use Tk;
use strict;
our($filename, $info);
my $mw = MainWindow->new;
# Create necessary widgets
my $f = $mw->Frame->pack(-side => 'top', -fill => 'x');
$f->Label(-text => "Filename:")->pack(-side => 'left', -anchor => 'w');
$f->Entry(-textvariable => \$filename)->
 pack(-side => 'left', -anchor => 'w', -fill => 'x', -expand => 1);
$f->Button(-text => "Exit", -command => sub { exit; } )->
 pack(-side => 'right');
$f->Button(-text => "Save", -command => \&save_file)->
 pack(-side => 'right', -anchor => 'e');
$f->Button(-text => "Load", -command => \&load_file)->
 pack(-side => 'right', -anchor => 'e');
$mw->Label(-textvariable => \$info, -relief => 'ridge')->
 pack(-side => 'bottom', -fill => 'x');
my $t = $mw->Scrolled("Text")->pack(-side => 'bottom', 
-fill => 'both', -expand => 1);
MainLoop;
sub load_file {
}
sub save_file {
}

Layout controls: Pack to the top

 #!/usr/local/bin/perl -w
use Tk;
use strict;
our($filename, $info);
my $mw = MainWindow->new;
# Create necessary widgets
my $f = $mw->Frame->pack(-side => 'top', -fill => 'x');
$f->Label(-text => "Filename:")->pack(-side => 'left', -anchor => 'w');
$f->Entry(-textvariable => \$filename)->
 pack(-side => 'left', -anchor => 'w', -fill => 'x', -expand => 1);
$f->Button(-text => "Exit", -command => sub { exit; } )->
 pack(-side => 'right');
$f->Button(-text => "Save", -command => \&save_file)->
 pack(-side => 'right', -anchor => 'e');
$f->Button(-text => "Load", -command => \&load_file)->
 pack(-side => 'right', -anchor => 'e');
$mw->Label(-textvariable => \$info, -relief => 'ridge')->
 pack(-side => 'bottom', -fill => 'x');
my $t = $mw->Scrolled("Text")->pack(-side => 'bottom', 
-fill => 'both', -expand => 1);
MainLoop;
sub load_file {
}
sub save_file {
}

Link a subroutine with a button action

 #!/usr/local/bin/perl -w
use Tk;
use strict;
my %info;
my $mw = MainWindow->new;
$mw->title("Data Entry");
my $f = $mw->Frame->pack(-side => 'bottom');
$f->Button(-text => "Exit", 
  -command => sub { exit; })->pack(-side => 'left');
$f->Button(-text => "Save",
  -command => sub {
print "asdf";
 })->pack(-side => 'bottom');
MainLoop;

Load and save text file

 #!/usr/local/bin/perl -w
use Tk;
use strict;
our($filename, $info);
my $mw = MainWindow->new;
# Create necessary widgets
my $f = $mw->Frame->pack(-side => 'top', -fill => 'x');
$f->Label(-text => "Filename:")->pack(-side => 'left', -anchor => 'w');
$f->Entry(-textvariable => \$filename)->
 pack(-side => 'left', -anchor => 'w', -fill => 'x', -expand => 1);
$f->Button(-text => "Exit", -command => sub { exit; } )->
 pack(-side => 'right');
$f->Button(-text => "Save", -command => \&save_file)->
 pack(-side => 'right', -anchor => 'e');
$f->Button(-text => "Load", -command => \&load_file)->
 pack(-side => 'right', -anchor => 'e');
$mw->Label(-textvariable => \$info, -relief => 'ridge')->
 pack(-side => 'bottom', -fill => 'x');
my $t = $mw->Scrolled("Text")->pack(-side => 'bottom', 
-fill => 'both', -expand => 1);
MainLoop;
sub load_file {
 $info = "Loading file '$filename'...";
 $t->delete("1.0", "end");
 if (!open(FH, "$filename")) {
 $t->insert("end", "ERROR: Could not open $filename\n"); 
  return; 
 }
 while (<FH>) { 
$t->insert("end", $_); 
 }
 close (FH);
 $info = "File '$filename' loaded";
}
sub save_file {
 $info = "Saving '$filename'";
 open (FH, ">$filename");
 print FH $t->get("1.0", "end");
 $info = "Saved.";
}

Mark text in a Scrolled Text Widget

 #!/usr/local/bin/perl -w
use Tk;
use strict;
my $mw = MainWindow->new;
my $t = $mw->Scrolled('Text')->pack(-fill => 'both', -expand => 1);
$t->insert('end', "test");
$t->markSet('one', '1.3');
$mw->Button(-text =>'left', 
-command => sub {
 $t->markGravity('one', 'left');
 $t->insert('one', '***'); 
}
  )->pack(-side => 'left');
$mw->Button(-text =>'right', 
-command => sub {
$t->markGravity('one', 'right');
$t->insert('one', '***');
 }
  )->pack(-side => 'left');
$mw->Button(-text => "Report", 
-command => sub { 
  my @m = $t->markNames(); 
  foreach (@m) {
print "MARK: $_ at ", $t->index($_), "\n";
  }
}
  )->pack(-side => 'left');
MainLoop;

Opening Files with a File Dialog

 #!/usr/bin/perl -w
use Tk;
use Tk::FileSelect;
$main = MainWindow->new();
$menubar = $main->Frame(-relief=>"raised",
-borderwidth=>2);
$filebutton = $menubar->Menubutton(-text=>"File",
  -underline => 0);  # F in File
$filemenu = $filebutton->Menu();
$filebutton->configure(-menu=>$filemenu);
$filemenu->command(-command => \&open_choice,
 -label => "Open...",
 -underline => 0); # O in Open
$filemenu->command(-command => \&dump_choice,
 -label => "Dump",
 -underline => 0); # D in Dump
$filemenu->separator();
$filemenu->command(-label => "Exit",
 -command => \&exit_choice,
 -underline => 1);  # "x" in Exit
$filebutton->pack(-side=>"left");
$menubar->pack(-side=>"top", -fill=>"x");
$text = $main->Scrolled('Text',
-relief=> "sunken",
-borderwidth => 2,
-setgrid  => "true",
-scrollbars  => 'se' );
$text->pack(-side=>"top", 
-expand => 1,
-fill => 'both');
$file_dialog = $main->FileSelect(-directory => ".");
MainLoop();
sub exit_choice {
 print "You chose the Exit choice!\n";
 exit;
}
sub open_choice {
 $filename = $file_dialog->Show();
 
 if ($filename ne "" ) {
  open (FILE, $filename);
  $text->delete("1.0", "end");
  while ($txt = <FILE>) {
$text->insert("end", $txt);
  }
  close(FILE);
 }
}
sub dump_choice {
 print $text->get("1.0", "end");
}

Pack Bottom

 #!/usr/bin/perl -w
use Tk;
$side = "bottom";
$Tk::strictMotif = 1;
$main = MainWindow->new();
$button1 = $main->Button(-text => "Button 1",
 -command => \&exit_button);
$button1->pack(-side=>$side);
$button2 = $main->Button(-text => "Button 2",
 -command => \&exit_button);
$button2->pack(-side=>$side);
$button3 = $main->Button(-text => "Button 3",
 -command => \&exit_button);
$button3->pack(-side=>$side);
MainLoop();
sub exit_button {
 print "You pushed the button!\n";
 exit;
}

Pack controls on a window

 use Tk;
my $main = MainWindow->new;
my $entry1 = $main->Entry->pack;
MainLoop;

Packing the MenuItem on a Menu Bar: left

 #!/usr/bin/perl -w
use Tk;
$main = MainWindow->new();
$menubar = $main->Frame(-relief=>"raised",
-borderwidth=>2);
$filebutton = $menubar->Menubutton(-text=>"File",
  -underline => 0);  # F in File
$filemenu = $filebutton->Menu();
$filebutton->configure(-menu=>$filemenu);
$filemenu->command(-command => \&open_choice,
 -label => "Open...",
 -underline => 0); # O in Open
$filemenu->separator();
$filemenu->command(-label => "Exit",
 -command => \&exit_choice,
 -underline => 1);  # "x" in Exit
# Help menu.
$helpbutton = $menubar->Menubutton(-text=>"Help",
  -underline => 0);  # H in Help
$helpmenu = $helpbutton->Menu();
$helpmenu->command(-command => \&about_choice,
 -label => "About TkMenu...",
 -underline => 0); # A in About
$helpbutton->configure(-menu=>$helpmenu);
$filebutton->pack(-side=>"left");
$helpbutton->pack(-side=>"right");
$menubar->pack(-side=>"top", -fill=>"x");
$label = $main->Label(-text => "Main Area");
$label->pack(-side=>"top", 
 -expand=>1,
 -padx=>100, 
 -pady=>100);
MainLoop();
sub exit_choice {
 print "You chose the Exit choice!\n";
 exit;
}
sub open_choice {
 print "Open file\n";
}
sub about_choice {
 print "About tkmenu.pl\n";
}

Packing the MenuItem on a Menu Bar: right

 #!/usr/bin/perl -w
use Tk;
$main = MainWindow->new();
$menubar = $main->Frame(-relief=>"raised",
-borderwidth=>2);
$filebutton = $menubar->Menubutton(-text=>"File",
  -underline => 0);  # F in File
$filemenu = $filebutton->Menu();
$filebutton->configure(-menu=>$filemenu);
$filemenu->command(-command => \&open_choice,
 -label => "Open...",
 -underline => 0); # O in Open
$filemenu->separator();
$filemenu->command(-label => "Exit",
 -command => \&exit_choice,
 -underline => 1);  # "x" in Exit
$helpbutton = $menubar->Menubutton(-text=>"Help",
  -underline => 0);  # H in Help
$helpmenu = $helpbutton->Menu();
$helpmenu->command(-command => \&about_choice,
 -label => "About TkMenu...",
 -underline => 0); # A in About
$helpbutton->configure(-menu=>$helpmenu);
$filebutton->pack(-side=>"left");
$helpbutton->pack(-side=>"right");
$menubar->pack(-side=>"top", -fill=>"x");
$label = $main->Label(-text => "Main Area");
$label->pack(-side=>"top", 
 -expand=>1,
 -padx=>100, 
 -pady=>100);
MainLoop();
sub exit_choice {
 print "You chose the Exit choice!\n";
 exit;
}
sub open_choice {
 print "Open file\n";
}
sub about_choice {
 print "About tkmenu.pl\n";
}

Pack Left

 #!/usr/bin/perl -w
use Tk;
$side = "left";
$Tk::strictMotif = 1;
$main = MainWindow->new();
$button1 = $main->Button(-text => "Button 1",
 -command => \&exit_button);
$button1->pack(-side=>$side);
$button2 = $main->Button(-text => "Button 2",
 -command => \&exit_button);
$button2->pack(-side=>$side);
$button3 = $main->Button(-text => "Button 3",
 -command => \&exit_button);
$button3->pack(-side=>$side);
MainLoop();
sub exit_button {
 print "You pushed the button!\n";
 exit;
}

Pack left, right, both

 use Tk;
my $main = MainWindow->new;
my $frame1 = $main->Frame;
$frame1->pack;
my $frame2 = $frame1->Frame;
$frame2->Button(-text => 'Click Me!')->pack(-side => 'left');
$frame2->Button(-text => 'Click Me!')->pack(-side => 'right');
$frame2->pack(-side => 'left');
my $frame3 = $frame1->Frame;
$frame3->Button(-text => 'Click Me!')->pack(-side => 'left');
$frame3->Button(-text => 'Click Me!')->pack(-side => 'right');
$frame3->pack(-side => 'right');
my $frame4 = $main->Frame;
$frame4->Button(-text => 'Click Me!')->pack(-side => 'left');
$frame4->Button(-text => 'Click Me!')->pack(-side => 'right');
$frame4->pack(-fill => 'both');
my $frame5 = $main->Frame;
$frame5->Button(-text => 'Click Me!')->pack(-side => 'left');
$frame5->Button(-text => 'Click Me!')->pack(-side => 'right');
$frame5->pack(-fill => 'both');
my $frame6 = $main->Frame;
$frame6->Button(-text => 'Click Me!')->pack(-side => 'left');
$frame6->Button(-text => 'Click Me!')->pack(-side => 'right');
$frame6->pack(-fill => 'both');
my $frame7 = $main->Frame;
$frame7->pack;
my $frame8 = $frame7->Frame;
$frame8->Button(-text => 'Click Me!')->pack(-side => 'left');
$frame8->Button(-text => 'Click Me!')->pack(-side => 'right');
$frame8->pack(-side => 'left');
my $frame9 = $frame7->Frame;
$frame9->Button(-text => 'Click Me!')->pack(-side => 'left');
$frame9->Button(-text => 'Click Me!')->pack(-side => 'right');
$frame9->pack(-side => 'right');
MainLoop;

Pack Right

 #!/usr/bin/perl -w
use Tk;
$side = "right";
$Tk::strictMotif = 1;
$main = MainWindow->new();
$button1 = $main->Button(-text => "Button 1",
 -command => \&exit_button);
$button1->pack(-side=>$side);
$button2 = $main->Button(-text => "Button 2",
 -command => \&exit_button);
$button2->pack(-side=>$side);
$button3 = $main->Button(-text => "Button 3",
 -command => \&exit_button);
$button3->pack(-side=>$side);
MainLoop();
sub exit_button {
 print "You pushed the button!\n";
 exit;
}

Pack Top

 #!/usr/bin/perl -w
use Tk;
$side = "top";
$Tk::strictMotif = 1;
$main = MainWindow->new();
$button1 = $main->Button(-text => "Button 1",
 -command => \&exit_button);
$button1->pack(-side=>$side);
$button2 = $main->Button(-text => "Button 2",
 -command => \&exit_button);
$button2->pack(-side=>$side);
$button3 = $main->Button(-text => "Button 3",
 -command => \&exit_button);
$button3->pack(-side=>$side);
MainLoop();
sub exit_button {
 print "You pushed the button!\n";
 exit;
}

Pass subroutine to button and get called when clicking

 use Tk;
my $main = MainWindow->new;
$main->Button(-text => 'Hello',
 -command => [\&printem, "Hello\n"]
)->pack;
$main->Button(-text => 'End',
 -command => [$main => 'destroy']
)->pack;
MainLoop;
sub printem
{
 print shift;
}

Pass value to a subroutine in button action

 use Tk;
my $main = MainWindow->new;
$main->Button(-text => 'Hello',
 -command => [\&printem, "Hello\n"]
)->pack;
$main->Button(-text => 'End',
 -command => [$main => 'destroy']
)->pack;
MainLoop;
sub printem
{
 print shift;
}

Prints out contents of Text widget to screen

 #!/usr/bin/perl -w
use Tk;
$main = MainWindow->new();
$menubar = $main->Frame(-relief => "raised",
-borderwidth => 2);
$filebutton = $menubar->Menubutton(-text => "File",
  -underline => 0);  # F in File
$filemenu = $filebutton->Menu();
$filebutton->configure(-menu=>$filemenu);
$filemenu->command(-command => \&open_choice,
 -label  => "Open...",
 -underline => 0); # O in Open
$filemenu->command(-command => \&dump_choice,
 -label  => "Print",
 -underline => 0); # P in Print
$filemenu->command(-label => "Exit",
 -command=> \&exit_choice,
 -underline => 1);  # "x" in Exit
$filebutton->pack(-side=>"left");
$menubar->pack(-side=>"top", -fill=>"x");
$text = $main->Scrolled('Text',
-relief=> "sunken",
-borderwidth => 2,
-setgrid  => "true",
-scrollbars  => 'se' );
  
$text->insert("1.0","this is a test.");
$text->pack(-side=>"top", 
-expand => 1,
-fill=> 'both');
MainLoop();
sub exit_choice {
 print "You chose the Exit choice!\n";
 exit;
}
sub open_choice {
 $status->configure(-text=>"Open file.");
 print "Open file\n";
}
sub dump_choice {
 $status->configure(-text=>"Dumping text...");
 print $text->get("1.0", "end");
}

RadioButton Menu

 use Tk; 

my $main = MainWindow->new;  
my $menubar = $main->Frame;
$menubar->pack(-fill => 'x');
my $filemenu = $menubar->Menubutton(-text => 'File');
$filemenu->command(
 -label => 'Open', 
 -command  => sub {$text1->insert('1.0', "You chose open.\n")},
 -accelerator => 'Ctrl+O',
);
$main->bind('<Control-o>' => sub {$text1->insert('1.0', "You chose open.\n")});
$filemenu->cascade(-label => 'Check buttons');
$filemenu->cascade(-label => 'Radio buttons');
my $checkcascade = $filemenu->cget(-menu); 
my $checkmenu = $checkcascade->Menu;
$filemenu->entryconfigure('Check buttons', -menu => $checkmenu);
$checkmenu->checkbutton(-label => 'Check 1', -variable => \$check1,
 -command => sub {$text1->insert('1.0', "You chose check 1.\n")});
$checkmenu->checkbutton(-label => 'Check 2', -variable => \$check2,
 -command => sub {$text1->insert('1.0', "You chose check 2.\n")});
$checkmenu->checkbutton(-label => 'Check 8', -variable => \$check8,
 -command => sub {$text1->insert('1.0', "You chose check 8.\n")});
my $radiocascade = $filemenu->cget(-menu); 
my $radiomenu = $radiocascade->Menu;
$filemenu->entryconfigure('Radio buttons', -menu => $radiomenu);
$radiomenu->radiobutton(-label => 'Radio 1', -variable => \$radio1,
 -command => sub {$text1->insert('1.0', "You chose radio 1.\n")});
$radiomenu->radiobutton(-label => 'Radio 2', -variable => \$radio1,
 -command => sub {$text1->insert('1.0', "You chose radio 2.\n")});
$radiomenu->separator;
$radiomenu->radiobutton(-label => 'Radio 5', -variable => \$radio2,
 -command => sub {$text1->insert('1.0', "You chose radio 5.\n")});
$radiomenu->radiobutton(-label => 'Radio 6', -variable => \$radio2,
 -command => sub {$text1->insert('1.0', "You chose radio 6.\n")});
$radiomenu->separator;
$filemenu->command('-label' => 'Exit', '-command' => sub {exit});
$filemenu->pack(-side => 'left');
$editmenu = $menubar->Menubutton('-text' => 'Edit')->pack('-side' => 
'left');
$editmenu->command(-label => 'Search', 
 -background => "red",
 -command => sub
 {$text1->delete('1.0', 'end');
 $text1->insert('end', "You chose search.");});
$editmenu->command(-label => 'Replace', 
 -background => "orange",
 -command => sub
 {$text1->delete('1.0', 'end');
 $text1->insert('end', "You chose replace.");});
$editmenu->command(-label => 'Find', 
 -background => "yellow",
 -command => sub
 {$text1->delete('1.0', 'end');
 $text1->insert('end', "You chose find.");});
$editmenu->pack(-side => 'left');
$text1 = $main->Text;
$text1->pack(-fill => 'both');
MainLoop;

Relayout(pack) the controls

 use Tk;
require Tk::BrowseEntry;
$numWidgets = 10;
$mw = MainWindow->new(-title => "Play w/pack");
$f = $mw->Frame(-borderwidth => 1, 
 -relief => 'groove')
 ->pack(-side => 'top', 
 -fill => 'x');
my (@packdirs) = ();
$i = 0;
foreach (0..$numWidgets)
{
  $packdirs[$_] = 'top';
  my $be = $f->BrowseEntry(-label => "Widget $_:", 
 -choices => ["right", "left", "top", "bottom"], 
 -variable => \$packdirs[$_], -browsecmd => \&repack)
 ->pack(-ipady => 5);
}
$f->Button(-text => "Repack", 
  -command => \&repack )
->pack(-anchor => 'center');
$top = $mw->Toplevel(-title => "output window");
my $c;
foreach (@packdirs)
{
  my $b = $top->Button(-text => $c++ . ": $_")
->pack(-side => $_, -fill => 'both', -expand => 1);
}
MainLoop;
sub repack
{
  @w = $top->packSlaves;
  foreach (@w) { $_->packForget; }
  my $e = 0;
  foreach (@w)
  {
 $_->configure(-text => "$e: $packdirs[$e]");
 $_->pack(-side => $packdirs[$e++], -fill => 'both', -expand => 1);
  }
}

Save Radio Button Selection Value to a scalar value

 #!/usr/bin/perl -w
use Tk;
$quality = "letter";
$main = MainWindow->new();
$label = $main->Label(-text => "Print Options");
$label->pack();
$frame = $main->Frame(-relief=>"groove",
 -borderwidth=>2);
$radio1 = $frame->Radiobutton(-text=>"Draft",
-variable=>\$quality,
-value=>"draft");
$radio1->pack(-side=>"top");
$radio2 = $frame->Radiobutton(-text=>"Letter",
-variable=>\$quality,
-value=>"letter");
$radio2->pack(-side=>"top");
$frame->pack();
$button = $main->Button(-text => "Exit",
-command => \&exit_button);
$button->pack();
MainLoop();
sub exit_button {
 if ( $both_sides eq "both") {
  print "Print both sides.\n";
 } else {
  print "Print single-sided.\n";
 }
 
 exit;
}

Set Button action command

 use Tk;
my $main = MainWindow->new;
$main->Button(-text => 'End',
 -command => [$main => 'destroy']
)->pack;
MainLoop;

Set Button Foreground Color

 #!/usr/bin/perl -w
use Tk;
$Tk::strictMotif = 1;
$main = MainWindow->new();
$button1 = $main->Button(-text => "Exit",
 -command => \&exit_button,
 -foreground => "orangered" );
$button1->pack();
$button1->configure(-background => "white" );
$button2 = $main->Button(-text => "Push Me",
 -command => \&change_color,
 -foreground => "black", 
 -background => "steelblue");
$button2->pack();
MainLoop();
sub exit_button {
 print "You pushed the button!\n";
 exit;
}
sub change_color {
 $button1->configure(-background => "red",
-foreground => "white");
 $button2->configure(-background => "maroon",
-foreground => "white",
-font => "-*-times-bold-r-normal-20-140-*");
}

Set Button Text

 #!/usr/bin/perl -w
use Tk;
$Tk::strictMotif = 1;
$main = MainWindow->new();
$button1 = $main->Button(-text => "Exit",
 -command => \&exit_button,
 -foreground => "orangered" );
$button1->pack();
$button1->configure(-background => "white" );
$button2 = $main->Button(-text => "Push Me",
 -command => \&change_color,
 -foreground => "black", 
 -background => "steelblue");
$button2->pack();
MainLoop();
sub exit_button {
 print "You pushed the button!\n";
 exit;
}
sub change_color {
 $button1->configure(-background => "red",
-foreground => "white");
 $button2->configure(-background => "maroon",
-foreground => "white",
-font => "-*-times-bold-r-normal-20-140-*");
}

Set Check Box Button onvalue and offvalue

 #!/usr/bin/perl -w
use Tk;
$both_sides = "single";
$single_sides = "double";
$main = MainWindow->new();
$label = $main->Label(-text => "Print Options");
$label->pack();
$frame = $main->Frame(-relief=>"groove",
 -borderwidth=>2);
$check1 = $frame->Checkbutton(-text=>"Both Sides",
-variable=>\$both_sides,
-onvalue=>"both",
-offvalue=>"single");
$check1->pack(-side=>"top");
$check2 = $frame->Checkbutton(-text=>"Single Sides",
-variable=>\$single_sides,
-onvalue=>"both",
-offvalue=>"single");
$check2->pack(-side=>"top");
$frame->pack();
$button = $main->Button(-text => "Exit",
-command => \&exit_button);
$button->pack();
MainLoop();
sub exit_button {
 if ( $both_sides eq "both") {
  print "Print both sides.\n";
 } else {
  print "Print single-sided.\n";
 }
 if ( $single_sides eq "both") {
  print "Print both sides.\n";
 } else {
  print "Print single-sided.\n";
 } 
 exit;
}

Set Check Box Button Text Value

 #!/usr/bin/perl -w
use Tk;
$both_sides = "single";
$single_sides = "double";
$main = MainWindow->new();
$label = $main->Label(-text => "Print Options");
$label->pack();
$frame = $main->Frame(-relief=>"groove",
 -borderwidth=>2);
$check1 = $frame->Checkbutton(-text=>"Both Sides",
-variable=>\$both_sides,
-onvalue=>"both",
-offvalue=>"single");
$check1->pack(-side=>"top");
$check2 = $frame->Checkbutton(-text=>"Single Sides",
-variable=>\$single_sides,
-onvalue=>"both",
-offvalue=>"single");
$check2->pack(-side=>"top");
$frame->pack();
$button = $main->Button(-text => "Exit",
-command => \&exit_button);
$button->pack();
MainLoop();
sub exit_button {
 if ( $both_sides eq "both") {
  print "Print both sides.\n";
 } else {
  print "Print single-sided.\n";
 }
 if ( $single_sides eq "both") {
  print "Print both sides.\n";
 } else {
  print "Print single-sided.\n";
 } 
 exit;
}

Set 'fill' for shape

 use Tk;
$main = MainWindow->new;
$canvas1 = $main->Canvas('-width' => 400,
 -height => 200
)->pack;
$canvas1->create ('oval', '50', '50', '160',
 '160', -fill => 'red');
MainLoop;

Set from value, to value, tickinterval, length

 use Tk;
$main = MainWindow->new();
$main->Scale('-orient'=> 'horizontal', 
 '-from' => 0,
 '-to' => 200, 
 '-tickinterval' => 40,
 '-label' => 'Select a value:', 
 '-length' => 200,
 '-variable' => \$value, 
 '-command' => \&display
)->pack;
$text1 = $main->Text ('-width'=> 40, 
 '-height' => 2
)->pack;
sub display
{
 $text1->delete('1.0','end');
 $text1->insert('end', "$value");
}
MainLoop;

Set Label relief (border) to raised

 use Tk;
my $main = MainWindow->new;
$main->Label(-text => 'Hello!',
 -relief => 'raised'
)->pack;
MainLoop;

Set Label relief (border) to sunken

 use Tk;
my $main = MainWindow->new;
$main->Label(-text => 'Hello!',
 -relief => 'sunken'
)->pack;
MainLoop;

Set Text for MenuItem

 #!/usr/bin/perl -w
use Tk;
$main = MainWindow->new();
$menubar = $main->Frame(-relief=>"raised",
-borderwidth=>2);
$filebutton = $menubar->Menubutton(-text=>"File",
  -underline => 0);  # F in File
$filemenu = $filebutton->Menu();
$filebutton->configure(-menu=>$filemenu);
$filemenu->command(-command => \&open_choice,
 -label => "Open...",
 -underline => 0); 
$filemenu->separator();
$filemenu->command(-label => "Exit",
 -command => \&exit_choice,
 -underline => 1); 
$helpbutton = $menubar->Menubutton(-text=>"Help",
  -underline => 0);  # H in Help
$helpmenu = $helpbutton->Menu();
$helpmenu->command(-command => \&about_choice,
 -label => "About TkMenu...",
 -underline => 0); # A in About
$helpbutton->configure(-menu=>$helpmenu);
$filebutton->pack(-side=>"left");
$helpbutton->pack(-side=>"right");
$menubar->pack(-side=>"top", -fill=>"x");
$label = $main->Label(-text => "Main Area");
$label->pack(-side=>"top", 
 -expand=>1,
 -padx=>100, 
 -pady=>100);
MainLoop();
sub exit_choice {
 print "You chose the Exit choice!\n";
 exit;
}
sub open_choice {
 print "Open file\n";
}
sub about_choice {
 print "About tkmenu.pl\n";
}

Setting Border Width for Frame

 #!/usr/bin/perl -w
use Tk;
$quality = "letter";
$main = MainWindow->new();
$label = $main->Label(-text => "Print Options");
$label->pack();
$frame = $main->Frame(-relief=>"groove",
 -borderwidth=>2);
$radio1 = $frame->Radiobutton(-text=>"Draft",
-variable=>\$quality,
-value=>"draft");
$radio1->pack(-side=>"top");
$radio2 = $frame->Radiobutton(-text=>"Letter",
-variable=>\$quality,
-value=>"letter");
$radio2->pack(-side=>"top");
$frame->pack();
$button = $main->Button(-text => "Exit",
-command => \&exit_button);
$button->pack();
MainLoop();
sub exit_button {
 if ( $both_sides eq "both") {
  print "Print both sides.\n";
 } else {
  print "Print single-sided.\n";
 }
 
 exit;
}

Setting Text for Radio Button

 #!/usr/bin/perl -w
use Tk;
$quality = "letter";
$main = MainWindow->new();
$label = $main->Label(-text => "Print Options");
$label->pack();
$frame = $main->Frame(-relief=>"groove",
 -borderwidth=>2);
$radio1 = $frame->Radiobutton(-text=>"Draft",
-variable=>\$quality,
-value=>"draft");
$radio1->pack(-side=>"top");
$radio2 = $frame->Radiobutton(-text=>"Letter",
-variable=>\$quality,
-value=>"letter");
$radio2->pack(-side=>"top");
$frame->pack();
$button = $main->Button(-text => "Exit",
-command => \&exit_button);
$button->pack();
MainLoop();
sub exit_button {
 if ( $both_sides eq "both") {
  print "Print both sides.\n";
 } else {
  print "Print single-sided.\n";
 }
 
 exit;
}

Setting the Underline Character for MenuItem

 #!/usr/bin/perl -w
use Tk;
$main = MainWindow->new();
$menubar = $main->Frame(-relief=>"raised",
-borderwidth=>2);
$filebutton = $menubar->Menubutton(-text=>"File",
  -underline => 0);  # F in File
$filemenu = $filebutton->Menu();
$filebutton->configure(-menu=>$filemenu);
$filemenu->command(-command => \&open_choice,
 -label => "Open...",
 -underline => 0); # O in Open
$filemenu->separator();
$filemenu->command(-label => "Exit",
 -command => \&exit_choice,
 -underline => 1);  # "x" in Exit
$helpbutton = $menubar->Menubutton(-text=>"Help",
  -underline => 0);  # H in Help
$helpmenu = $helpbutton->Menu();
$helpmenu->command(-command => \&about_choice,
 -label => "About TkMenu...",
 -underline => 0); # A in About
$helpbutton->configure(-menu=>$helpmenu);
$filebutton->pack(-side=>"left");
$helpbutton->pack(-side=>"right");
$menubar->pack(-side=>"top", -fill=>"x");
$label = $main->Label(-text => "Main Area");
$label->pack(-side=>"top", 
 -expand=>1,
 -padx=>100, 
 -pady=>100);
MainLoop();
sub exit_choice {
 print "You chose the Exit choice!\n";
 exit;
}
sub open_choice {
 print "Open file\n";
}
sub about_choice {
 print "About tkmenu.pl\n";
}

Set width and height of a Text

 use Tk;
$main = MainWindow->new();
$main->Button( -text => "Click Me!",
 -command => \&display
)->pack(-side => "left");
$text1 = $main->Text ('-width'=> 40, '-height' => 2
)->pack;
sub display
{
 $text1->insert('end', "Hello!");
}
MainLoop;

Show a dialog box

 use Tk;
$main = MainWindow->new();
$dialog = $main->DialogBox(
 -title => "Dialog box",
 -buttons => ["OK", "Cancel"]
);
$entry = $dialog->add(
 "Entry", -width => 40
)->pack;
$main->Button( 
 -text => "Show dialog box",
 -command => \&show
)->pack;
$text1 = $main->Text (
 -width => 40, 
 -height => 2
)->pack();
MainLoop;
sub show 
{
 $result = $dialog->Show;
 if ($result eq "OK") {
  $text1->delete('1.0','end');
  $text1->insert('end', $entry->get);
 }
}

Single-Line Text Entry

 #!/usr/bin/perl -w
use Tk;
$main = MainWindow->new();
$label = $main->Label(-text=>"Enter user name:");
$label->pack(-side=>"left");
$entry = $main->Entry();
$entry->bind("<Return>", \&handle_return );
$entry->pack(-side=>"left");
MainLoop();
sub handle_return {
 $txt = $entry->get();
 print "You entered $txt\n";
 exit;
}

Tk Configuration Options

 Option  Use
-activebackgroundbackground color when widget is active.
-activeborderwidth  width of border when widget is active.
-activeforegroundforeground color when widget is active.
-anchor one of n, ne, e, se, s, sw, w, nw, or center.
-backgroundnormal background color.
-bg  normal background color, same as Cbackground
-bitmap bitmap to error, gray50, gray25, hourglass, info, questhead, question, or warning.
-borderwidth  widget border width.
-bd  widget border width, same as Cborderwidth
-cursor cursor shape.
-disabledforeground foreground color used when widget is disabled.
-exportselection Allows for copy and paste between applications.
-fontfont. 
-foregroundforeground color.
-fg  normal foreground color, same as Cforeground.
-highlightbackgroundhighlighted background color.
-highlightcolor  color of highlight rectangle.
-highlightthickness thickness of highlight rectangle.
-image  widget to display an image.
-insertbackgroundbackground color for insertion cursor.
-insertborderwidth  width of border around insertion cursor.
-insertwidth  width of insertion cursor. 
-jumpMakes scrolling widgets jump, rather than move smoothly, when set to true.
-justifyControls how lines of text within the widget line up; set to left, center, or right;.
-orient Controls orientation of scroll bars; set to horizontal or vertical.
-padxPads extra space (in pixels) horizontally.
-padyPads extra space (in pixels) vertically.
-relief Controls 3D border around widget, one of raised, sunken, flat (no relief), ridge, solid, or groove.
-selectbackgroundSets background color for selected items.
-selectborderwidth  Controls width of border for selected items.
-selectforegroundSets foreground color for selected items.
-textControls text to be displayed.
-underline Specifies index of character to underline, used for menu choices.

tkphone - Phone another X Display and have a line-mode conversation

 #Copyright (C) 1999 - 2000 ACME Rocket Supply, Inc. All rights reserved.
#This program is free software; you can redistribute it and/or modify it under
#the same terms as Perl itself.
#!/usr/local/bin/perl -w
#
# tkphone - Phone another X Display and have a line-mode conversation.
#
# Usage: see POD for details.
use Tk;
use subs qw/beep phone pconfig/;
use strict;
$ENV{DISPLAY} ||= ':0'; $ARGV[0] ||= $ENV{DISPLAY};
my $title = "$ENV{DISPLAY}phoning$ARGV[0]";
my $lmw = MainWindow->new(-title => $title);
my $rmw = MainWindow->new(-title => $title, -screen => $ARGV[0]);
my($le, $lt) = phone $lmw;
my($re, $rt) = phone $rmw;
pconfig $le, $lt, $re, $rt;
pconfig $re, $rt, $le, $lt; $rmw->bell;
MainLoop;
sub phone {
 # Create the menubar and the phone text entry/display area.
 my($screen) = @_;
 my $menubar = $screen->Menu;
 $screen->configure(-menu => $menubar); 
 my $file = $menubar->cascade(-label => '~File');
 $file->command(-label => "Close", -command => [$screen => 'destroy']);
 $file->command(-label => "Exit",  -command => \&exit);
 my $e = $screen->Entry->pack(qw/-fill x -expand 1/);
 $e->focus;
 my $t = $screen->Text(qw/-height 10/)->pack;
 ($e, $t);
}
sub pconfig {
 # Configure local callbacks to talk to the remote party.
 my($le, $lt, $re, $rt) = @_;
 $le->bind('<Return>' => [sub {
  my($le, $lt, $re, $rt) = @_;
  $rt->tagConfigure(qw/blue -underline 1/);
  my $input = $le->get . "\n";
  $le->delete(0, 'end');
  $lt->insert('end' => $input);
  $rt->insert('end' => $input, 'blue');
 },  $lt, $re, $rt]);
}
__END__
=head1 NAME
tkphone - Phone another X Display and have a line-mode conversation.
=head1 SYNOPSIS
B<tkphone> [I<display>]
=head1 DESCRIPTION
This program opens two MainWindows and arranges callbacks so they can
talk to each other.  It expects a single command line argument, the
remote
DISPLAY
specification
(defaults to :0 so you can phone yourself).
=head1 COPYRIGHT
Copyright (C) 1999 - 2000 ACME Rocket Supply, Inc. All rights reserved.
This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
=cut

Update entry content based on the selection in a list box

 #!/usr/local/bin/perl -w
use Tk;
use strict;
my $str = "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz0123456789";
my $mw = MainWindow->new;
my $lframe = $mw->Frame->pack(-fill => 'both', -side => 'left', -expand => 1);
my $lb = $lframe->Scrolled(qw/Listbox -scrollbars e -height 3/)-> pack(qw/-fill both -expand 1 -side top/);
$lb->insert('end', sort $mw->fontFamilies);
my $entry = $mw->Entry(
 -textvariable => \$str,
 -width => 12, 
 -font => "{Comic Sans MS} 72",
 -relief => 'raised',
 -highlightthickness => 0,
)->pack(-expand => 1, -fill => 'x', -side => 'left');
$lb->bind("<Button>", sub { $entry->configure(-font =>
 "{". $lb->get($lb->curselection) . "} 72"); });
MainLoop;

Use the Scrolled to control the scroll of a Text Entry

 use Tk;
my $main = MainWindow->new;
my $entry1 = $main->Entry->pack;
my $entry2 = $main->Scrolled(
 Entry,
 -relief => 'sunken',
 -scrollbars => 's'
)->pack;
$entry1->insert(
 0,
 'Here is some long text that you have to scroll to see.'
);
$entry2->insert(
 0,
 'Here is some long text that you have to scroll to see.'
);
MainLoop;

Using a canvas control

 #!/usr/local/bin/perl -w
use Tk;
use strict;
my $mw = MainWindow->new;
my $c= $mw->Canvas->pack(-fill => 'both', -expand => 1);
$c->createArc(0,0,100,150, -extent => 270);
MainLoop;

Using buildin bitmap: error

 use Tk;
my $main = MainWindow->new;
$main->Label(-bitmap => 'error')->pack;
MainLoop;

Using buildin bitmap: gray12

 use Tk;
my $main = MainWindow->new;
$main->Label(-bitmap => 'gray12')->pack;
MainLoop;

Using buildin bitmap: gray25

 use Tk;
my $main = MainWindow->new;
$main->Label(-bitmap => 'gray25')->pack;
MainLoop;

Using buildin bitmap: gray50

 use Tk;
my $main = MainWindow->new;
$main->Label(-bitmap => 'gray50')->pack;
MainLoop;

Using buildin bitmap: gray75

 use Tk;
my $main = MainWindow->new;
$main->Label(-bitmap => 'gray75')->pack;
MainLoop;

Using buildin bitmap: hourglass

 use Tk;
my $main = MainWindow->new;
$main->Label(-bitmap => 'hourglass')->pack;
MainLoop;

Using buildin bitmap: info

 use Tk;
my $main = MainWindow->new;
$main->Label(-bitmap => 'info')->pack;
MainLoop;

Using buildin bitmap: questhead

 use Tk;
my $main = MainWindow->new;
$main->Label(-bitmap => 'questhead')->pack;
MainLoop;

Using buildin bitmap: question

 use Tk;
my $main = MainWindow->new;
$main->Label(-bitmap => 'question')->pack;
MainLoop;

Using buildin bitmap: warning

 use Tk;
my $main = MainWindow->new;
$main->Label(-bitmap => 'warning')->pack;
MainLoop;

Using check box to control font

 #!/usr/local/bin/perl -w
use Tk;
use strict;
require Tk::BrowseEntry;
my $mw = MainWindow->new(-title => 'Font Viewer');
my $f = $mw->Frame->pack(-side => 'top');
my $family = 'Courier';
my $be = $f->BrowseEntry(
 -label  => "Family:", 
 -variable  => \$family, 
 -browsecmd => \&apply_font,
)->pack(-fill => 'x', -side => 'left');
$be->insert('end', sort $mw->fontFamilies);
my $size = 24;
my $bentry = $f->BrowseEntry(
 -label  => 'Size',
 -variable  => \$size, 
 -browsecmd => \&apply_font,
)->pack(-side => 'left');
$bentry->insert('end', (3 .. 32));
my $weight = "normal";
$f->Checkbutton(
 -onvalue  => "bold",
 -offvalue => "normal",
 -text  => "Weight",
 -variable => \$weight,
 -command  => \&apply_font,
)->pack(-side => 'left');
my $slant = "roman";
$f->Checkbutton(
 -onvalue => "italic",
 -offvalue => "roman", 
 -text => "Slant",
 -variable => \$slant, 
 -command => \&apply_font,
)->pack(-side => 'left');
my $underline = 0;
$f->Checkbutton(
 -text => "Underline",
 -variable => \$underline,
 -command => \&apply_font,
)->pack(-side => 'left');
my $overstrike = 0; 
$f->Checkbutton(
 -text => "Overstrike",
 -variable => \$overstrike, 
 -command => \&apply_font,
)->pack(-side => 'left');
my $stext = "www.java2s.com";
my $sample = $mw->Entry(-textvariable => \$stext)->pack(-fill => 'x');
&apply_font;
MainLoop;
sub apply_font {
 $sample->configure(-font => 
  [-family => $family,
-size => $size,
-weight => $weight,
-slant => $slant,
-underline => $underline,
-overstrike => $overstrike
  ],
 );
}

Using grid to control widget placement: bottom

 #!/usr/bin/perl -w
use Tk;
$side = "bottom";
$Tk::strictMotif = 1;
$main = MainWindow->new();
$button1 = $main->Button(-text => "Button 1",
 -command => \&exit_button);
$button2 = $main->Button(-text => "Button 2",
 -command => \&exit_button);
$button3 = $main->Button(-text => "Button 3",
 -command => \&exit_button);
if ($side eq "left" ) {
$button1->grid(-column => 0, -row => 0);
$button2->grid(-column => 1, -row => 0);
$button3->grid(-column => 2, -row => 0);
} elsif ($side eq "right" ) {
$button1->grid(-column => 2, -row => 0);
$button2->grid(-column => 1, -row => 0);
$button3->grid(-column => 0, -row => 0);
} elsif ($side eq "top" ) {
$button1->grid(-column => 0, -row => 0);
$button2->grid(-column => 0, -row => 1);
$button3->grid(-column => 0, -row => 2);
} elsif ($side eq "bottom" ) {
$button1->grid(-column => 0, -row => 2);
$button2->grid(-column => 0, -row => 1);
$button3->grid(-column => 0, -row => 0);
}
MainLoop();
sub exit_button {
 print "You pushed the button!\n";
 exit;
}

Using grid to control widget placement: left

 #!/usr/bin/perl -w
use Tk;
$side = "left";
$Tk::strictMotif = 1;
$main = MainWindow->new();
$button1 = $main->Button(-text => "Button 1",
 -command => \&exit_button);
$button2 = $main->Button(-text => "Button 2",
 -command => \&exit_button);
$button3 = $main->Button(-text => "Button 3",
 -command => \&exit_button);
if ($side eq "left" ) {
$button1->grid(-column => 0, -row => 0);
$button2->grid(-column => 1, -row => 0);
$button3->grid(-column => 2, -row => 0);
} elsif ($side eq "right" ) {
$button1->grid(-column => 2, -row => 0);
$button2->grid(-column => 1, -row => 0);
$button3->grid(-column => 0, -row => 0);
} elsif ($side eq "top" ) {
$button1->grid(-column => 0, -row => 0);
$button2->grid(-column => 0, -row => 1);
$button3->grid(-column => 0, -row => 2);
} elsif ($side eq "bottom" ) {
$button1->grid(-column => 0, -row => 2);
$button2->grid(-column => 0, -row => 1);
$button3->grid(-column => 0, -row => 0);
}
MainLoop();
sub exit_button {
 print "You pushed the button!\n";
 exit;
}

Using grid to control widget placement: right

 #!/usr/bin/perl -w
use Tk;
$side = "right";
$Tk::strictMotif = 1;
$main = MainWindow->new();
$button1 = $main->Button(-text => "Button 1",
 -command => \&exit_button);
$button2 = $main->Button(-text => "Button 2",
 -command => \&exit_button);
$button3 = $main->Button(-text => "Button 3",
 -command => \&exit_button);
if ($side eq "left" ) {
$button1->grid(-column => 0, -row => 0);
$button2->grid(-column => 1, -row => 0);
$button3->grid(-column => 2, -row => 0);
} elsif ($side eq "right" ) {
$button1->grid(-column => 2, -row => 0);
$button2->grid(-column => 1, -row => 0);
$button3->grid(-column => 0, -row => 0);
} elsif ($side eq "top" ) {
$button1->grid(-column => 0, -row => 0);
$button2->grid(-column => 0, -row => 1);
$button3->grid(-column => 0, -row => 2);
} elsif ($side eq "bottom" ) {
$button1->grid(-column => 0, -row => 2);
$button2->grid(-column => 0, -row => 1);
$button3->grid(-column => 0, -row => 0);
}
MainLoop();
sub exit_button {
 print "You pushed the button!\n";
 exit;
}

Using grid to control widget placement: top

 #!/usr/bin/perl -w
use Tk;
$side = "top";
$Tk::strictMotif = 1;
$main = MainWindow->new();
$button1 = $main->Button(-text => "Button 1",
 -command => \&exit_button);
$button2 = $main->Button(-text => "Button 2",
 -command => \&exit_button);
$button3 = $main->Button(-text => "Button 3",
 -command => \&exit_button);
if ($side eq "left" ) {
$button1->grid(-column => 0, -row => 0);
$button2->grid(-column => 1, -row => 0);
$button3->grid(-column => 2, -row => 0);
} elsif ($side eq "right" ) {
$button1->grid(-column => 2, -row => 0);
$button2->grid(-column => 1, -row => 0);
$button3->grid(-column => 0, -row => 0);
} elsif ($side eq "top" ) {
$button1->grid(-column => 0, -row => 0);
$button2->grid(-column => 0, -row => 1);
$button3->grid(-column => 0, -row => 2);
} elsif ($side eq "bottom" ) {
$button1->grid(-column => 0, -row => 2);
$button2->grid(-column => 0, -row => 1);
$button3->grid(-column => 0, -row => 0);
}
MainLoop();
sub exit_button {
 print "You pushed the button!\n";
 exit;
}

Using One Scrollbar to control the scroll of Three Listboxes

 #!/usr/local/bin/perl -w
use Tk;
use strict;
my $mw = MainWindow->new();
$mw->title("This is the title");
$mw->Button(-text => "Exit", 
-command => sub { exit })->pack(-side => 'bottom');
my $scroll = $mw->Scrollbar();
my $listboxes = [ $mw->Listbox(), $mw->Listbox(), $mw->Listbox() ];
sub scroll_listboxes {
 my ($sb, $scrolled, $lbs, @args) = @_;
 $sb->set(@args); # tell the Scrollbar what to display
 my ($top, $bottom) = $scrolled->yview();
 foreach my $list (@$lbs) {
  $list->yviewMoveto($top); # adjust each lb
 }
}
foreach my $list (@$listboxes) {
 $list->configure(-yscrollcommand => [ \&scroll_listboxes, $scroll,
$list, $listboxes ]);
}
$scroll->configure(-command => sub {
  foreach my $list (@$listboxes) {
$list->yview(@_);
  }});
$scroll->pack(-side => 'left', -fill => 'y');
foreach my $list (@$listboxes) {
 $list->pack(-side => 'left');
 $list->insert('end', qw/one two three four five six seven eight nine ten eleven twelve thirteen/);
}
MainLoop;

Using pack to control widget placement

 Options for pack 
Option Usage
-after=>$widget Places this widget after $widget.
-before=>$widgetPlaces this widget before $widget.
-expand=>1Allows widget to expand to fill unused space.
-expand=>0Turns off expansion in filling unused space.
-fill=>x  Fills widget out horizontally.
-fill=>y  Fills widget out vertically.
-fill=>both  Fills widget out both horizontally and vertically.
-side=>bottomPacks widget from bottom.
-side=>left  Packs widget from left.
-side=>right Packs widget from right.
-side=>topPacks widget from top.

Using place method to set control location

 use Tk;
my $main = MainWindow->new;
$button1 = $main->Button(-text => 'Click Me!')->place(-x => 0, -y => 0);
$button1 = $main->Button(-text => 'Click Me!')->place(-x => 30, -y => 30);
$button1 = $main->Button(-text => 'Click Me!')->place(-x => 60, -y => 60);
$button1 = $main->Button(-text => 'Click Me!')->place(-x => 90, -y => 90);
$button1 = $main->Button(-text => 'Click Me!')->place(-x => 120, -y => 120);
$button1 = $main->Button(-text => 'Click Me!')->place(-x => 150, -y => 150);
MainLoop;

Using Scale control

 use Tk;
$main = MainWindow->new();
$main->Scale('-orient'=> 'horizontal', 
 '-from' => 0,
 '-to' => 200, 
 '-tickinterval' => 40,
 '-label' => 'Select a value:', 
 '-length' => 200,
 '-variable' => \$value, 
 '-command' => \&display
)->pack;
$text1 = $main->Text ('-width'=> 40, 
 '-height' => 2
)->pack;
sub display
{
 $text1->delete('1.0','end');
 $text1->insert('end', "$value");
}
MainLoop;

Using Scroll Bar to control a list box

 use Tk;
my $main = MainWindow->new;
my $listbox1 = $main->Listbox(-width => 25,
 -height => 5);
$listbox1->insert('end', "Apples", "Blueberries",
 "Bananas", "Kiwis", "Mangoes", "Oranges",
 "Pears", "Pineapples");
my $scroll1 = $main->Scrollbar(-command => ['yview', $listbox1]);
$listbox1->configure(-yscrollcommand => ['set', $scroll1]);
$listbox1->pack(-side => 'left', -fill => 'both');
$scroll1->pack(-side => 'right', -fill => 'y');
MainLoop;

Your first Perl/Tk program

 #!/usr/bin/perl
use Tk;
my $mw = MainWindow->new;
$mw->title('Hello World');
$mw->Button(-text => 'Done', -command => sub { exit })->pack;
MainLoop;

Write Your Comments or Suggestion...

Perl Tutorial - Practical Extraction and Reporting Language (Perl)

Table of Contents

Perl GUI Program