Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

I've been trying all morning to figure out how to make a menu item change the background color of my window AND print text to it. The best I've figured is the code below, but when the color and text changes are applied the window blows uo. How can I fix this? 
#!/usr/local/bin/perl -w 

use 5.005; 
use Tk; 
use Tk::widgets qw/Dialog/; 
use subs qw/build_menubar fini/; 
use vars qw/$MW $VERSION/; 
use strict; 

$MW = MainWindow->new; 

my $menubar = build_menubar; 
my $Body = $MW->Frame(qw/-width 640 -height 100 -background cyan/)->pa
+ck; 

MainLoop; 

sub build_menubar { 
my $menubar = $MW->Menu; 
$MW->configure(-menu => $menubar); 
my $file = $menubar->cascade(-label => '~File'); 
$file->command(-label => "Print Text", -command => \&PrintText);
$file->command(-label => "Quit", -command => \&fini); 
$menubar;
}

sub PrintText{
my $lbl = $Body->Label(-text => "This is new text", -background => 're
+d', -width => '100', -height => '100' )->pack(-side => 'top');
}

sub fini { exit; }

[download]

Replies are listed 'Best First'.
Re: Perl/Tk menu item
by pg (Canon) on Dec 06, 2002 at 21:01 UTC
    I guess you are saying that, you could not change the background color of your main window. One big posibility is that, you might have successfully changed the color without your notice, at some point during your try.

    Is this posible? Yes, there is a common confusion in this kind of case. As your $Body frame covers the whole main window, also your label covers your entire $Body frame, you just can not see your main window and $Body at all.

    What you can do is, when you call function pack, specify padx, and pady options, and this will pad spaces around your widget, so you can always see piece of its parent widget. For example: 
    $Body->Label(-text => "abcd")->pack(padx => 10, pady => 10);

    [download]
    Enjoy!
[reply]
[d/l]
(bbfu) Re: Perl/Tk menu item
by bbfu (Curate) on Dec 07, 2002 at 04:54 UTC

    The reason the window expands to such a large size when you add the label is that the width and height you are passing to the Label constructor are interpreted as the width in characters and the height in lines. Thus, you're requesting that the label be 100 lines tall, and 100 characters wide. The window expands to fit it.

    Unfortunately, there doesn't really seem to be a way to specify the size of the label in pixels, unless you are displaying a bitmap. Judging from how you specify the desired new background color of the window as the label background color, however, you really want the label to fill up the window anyway. Thus, you should tell pack to fill and expand the label, and not give it a size.

    This prevents the problem with the window expanding when you pack the label but uncovers the problem that the window now shrinks to the minimum possible size to accommodate all of its widgets (in this case, the menu and label). This is due to the way geometry management is done with Toplevel widgets by the Tk Window Manager interface (Tk::Wm). To get around this, you should use the geometry method for the MainWindow (it's documented under Tk::Wm).

    Well, here's your code, updated with these changes. 

    #!/usr/local/bin/perl -w 

use 5.005; 
use Tk; 
use Tk::widgets qw/Dialog/; 
use subs qw/build_menubar fini/; 
use vars qw/$MW $VERSION/; 
use strict; 

$MW = MainWindow->new(); 
$MW->geometry('640x100');

my $menubar = build_menubar; 
my $Body = $MW->Frame(-background => 'cyan')->pack(
  -expand => 1,
  -fill   => 'both',
); 

MainLoop; 

sub build_menubar { 
  my $menubar = $MW->Menu; 
  my $file    = $menubar->cascade(-label => '~File'); 

  $MW->configure(-menu => $menubar); 
  $file->command(-label => "Print Text", -command => \&PrintText);
  $file->command(-label => "Quit",       -command => \&fini); 

  return $menubar;
}

sub PrintText{
  my $lbl = $Body->Label(
    -text       => "This is new text",
    -background => 'red',
    #-width      => '100',  # This would be 100 _characters_
    #-height     => '100',  # And this 100 _lines_
  )->pack(
    -fill   => 'both',
    -expand => 1,
  );
}

sub fini { exit; }

    [download]

    bbfu
    Black flowers blossum
    Fearless on my breath

[reply]
[d/l]

Back to Seekers of Perl Wisdom