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

# Hello all # How do I colour the non-white area in the following white (leaving t +he labframe groove around it :) # 343 metres/meters per second at 20 use Tk; require Tk::LabFrame; use Tk::LabEntry; my $diswindow = MainWindow->new(-title => "Distances...",); $diswindow->minsize(qw(700 80)); $diswindow->maxsize(qw(700 80)); my $colour = 'white'; my $Temp : shared = 20; my $Temp3 : shared = ("\x{00B0}"); $diswindow->configure(-bg => $colour,); # labframe for distances my $f1 = $diswindow->LabFrame(-bg => $colour, -label => "Test distanc +es (in meters) and time taken to travel such at temperature (in \x{00 +B0}C).", -labelside => "acrosstop")->pack(-padx => 5, -pady => 7); # the \x{00B0} in the above prints the "UTF-8/**** encoded degree symb +ol" # check this again because it looks wrong ?!? # Abbrev of celsius is just C ??! # don't want left, rightk top or bottom want "acrosstop" # The acrosstop creates a grooved frame around the central frame and p +uts the label # near the northwest corner such that it appears to ``overwrite'' the +groove. # breakup f1 labframe # my $topframe4u=$f1->Frame(-bg => $colour,)->pack(-side=>'top', -fill +=>'x'); my $leftframe4u=$f1->Frame(-bg => $colour,)->pack(-side=>'left', -fill +=>'y'); my $rightframe4u=$f1->Frame(-bg => $colour,)->pack(-side=>'left', -fil +l=>'y'); my $rightframe4temp=$f1->Frame(-bg => $colour,)->pack(-side=>'left', - +fill=>'y'); my $a_to_b_distance = 343; # # Showing that distance: my $atbdis = $leftframe4u->LabEntry(-bg => $colour, -label => "a to b +distance =", -labelPack => [-side => "left"], -width => 10, -textvari +able => \$a_to_b_distance)->pack(-side => 'left', -padx => 5, -pady => 5); $atbdis->configure(-bg => $colour,); # The distance of $a to $b is then travelled by sound in say $time_a_t +o_b # showing the time: my $time_a_to_b = ($a_to_b_distance / 343 ); my $a_b = ("a to b is then travelled by sound in... "); my $wida = $rightframe4u->Label(-bg => $colour, -width => 49, -text => + $a_b . $time_a_to_b, )->pack(-side => 'left', -padx => 1, -pady => 5 +); # $Temp3 = ("\x{00B0}"); $say1 = ("when the tempreature is "); # showing the temp: my $wid = $rightframe4temp->Label(-bg => $colour, -width => 24, -text +=> $say1 . $Temp . $Temp3, )->pack(-side => 'left', -padx => 1, -pad +y => 5); MainLoop;
Am on Windows XP Home With ActiveState ActivePerl 5.8 Also use EnginSite Perl Editor LITE

2005-11-28 Retitled by g0n, as per Monastery guidelines
Original title: 'Skin'

Replies are listed 'Best First'.
Re: Adding a Skin to a Tk widget
by zentara (Cardinal) on Nov 28, 2005 at 13:22 UTC
    I'm using linux, TK804.027 and it is all white. What non-white area are you talking about? For a starter, you can try to insert different colors than white.
    my $colour = 'white'; my $colour1 = 'lightsteelblue'; my $colour2 = 'lightgreen';
    then change the places where $colour is specified, to $colour1, etc.

    I'm not really a human, but I play one on earth. flash japh
Re: Adding a Skin to a Tk widget
by Anonymous Monk on Nov 28, 2005 at 13:48 UTC
    It dosn't come up white for me just under the LabFrame's top line/edge... and the text has a white background, that looks like its on top of that same line ????? About your comment on changeing the colour... I'm also trying to get this working to change it:
    $init_label->configure(-bg => $mw->chooseColor(-initialcolor => 'gray' +, -title => "Choose color")); to output it's colour to a file... as of: ### my $infile4ccc = "C:\\Perl\\tk\\prog2\\colour.txt"; # var from + choise should be but in here ??? open(OUTFILEcc, "> $infile4ccc") or die "Can't open colour.txt: $!"; print OUTFILEcc "white"; # print to the file the chosen colour f +rom the above choosecolor thingy close OUTFILEcc; # then without reading from the file, I want to set $colour (globaly/* +***) to the chosen colour too.
    I can get $init_label's background on my $mw to change to the colour choise... or is that the other way around, but I want to set a var to the color chosen if that makes sence.
Re: Adding a Skin to a Tk widget
by Anonymous Monk on Nov 28, 2005 at 17:46 UTC
    Hear's a link: http://www.btinternet.com/~afrancisglelxl/w1.jpg and for second part:
    use Tk; require Tk::LabFrame; use Tk::LabEntry; my $diswindow = MainWindow->new(-title => "Distances...",); $diswindow->minsize(qw(700 100)); $diswindow->maxsize(qw(700 100)); my $colour = 'lightsteelblue'; my $Temp : shared = 20; my $Temp3 : shared = ("\x{00B0}"); $diswindow->configure(-bg => $colour,); # labframe for distances my $f1 = $diswindow->LabFrame(-bg => $colour, -label => "Test distanc +es (in meters) and time taken to travel such at temperature (in \x{00 +B0}C).", -labelside => "acrosstop")->pack(-padx => 5, -pady => 7); # the \x{00B0} in the above prints the "UTF-8/**** encoded degree symb +ol" # check this again because it looks wrong ?!? # Abbrev of celsius is just C ??! # don't want left, rightk top or bottom want "acrosstop" # The acrosstop creates a grooved frame around the central frame and p +uts the label # near the northwest corner such that it appears to ``overwrite'' the +groove. # breakup f1 labframe # my $topframe4u=$f1->Frame(-bg => $colour,)->pack(-side=>'top', -fill +=>'x'); my $leftframe4u=$f1->Frame(-bg => $colour,)->pack(-side=>'left', -fill +=>'y'); my $rightframe4u=$f1->Frame(-bg => $colour,)->pack(-side=>'left', -fil +l=>'y'); my $rightframe4temp=$f1->Frame(-bg => $colour,)->pack(-side=>'left', - +fill=>'y'); my $a_to_b_distance = 343; # # Showing that distance: my $atbdis = $leftframe4u->LabEntry(-bg => $colour, -label => "a to b +distance =", -labelPack => [-side => "left"], -width => 10, -textvari +able => \$a_to_b_distance)->pack(-side => 'left', -padx => 5, -pady => 5); $atbdis->configure(-bg => $colour,); # The distance of $a to $b is then travelled by sound in say $time_a_t +o_b # showing the time: my $time_a_to_b = ($a_to_b_distance / 343 ); my $a_b = ("a to b is then travelled by sound in... "); my $wida = $rightframe4u->Label(-bg => $colour, -width => 49, -text => + $a_b . $time_a_to_b, )->pack(-side => 'left', -padx => 1, -pady => 5 +); # $Temp3 = ("\x{00B0}"); $say1 = ("when the tempreature is "); # showing the temp: my $wid = $rightframe4temp->Label(-bg => $colour, -width => 24, -text +=> $say1 . $Temp . $Temp3, )->pack(-side => 'left', -padx => 1, -pad +y => 5); my $n1 = $diswindow->Button(-text => 'Skin', -command => \&butone, -borderwidth => '0', -bg => $colour, -activebackground => $colour,)->p +ack(-side => 'left', -padx => 1, -pady => 1); # to turn off the windo +w ($noise), etc... but also add something for the display/screen itse +lf. sub butone { @skinframs = ($leftframe4u, $rightframe4u, $rightframe4temp, $f1, $dis +window, # ); ##### $n1 @skinframs[4]->configure(-bg => $diswindow->chooseColor(-initialcolor +=> $colour, -title => "Choose color")); ################# so insteat of $diswindow in the above how would i en +ter @skinframs[0..$#skinframs]; # then output the colour chosen to a file... as of: ### my $infile4ccc = "C:\\Perl\\tk\\prog2\\colour.txt"; # var from + choise should be but in here ??? open(OUTFILEcc, "> $infile4ccc") or die "Can't open colour.txt: $!"; print OUTFILEcc "white"; # instead of white, print to the file t +he chosen colour from the above choosecolor thingy close OUTFILEcc; } MainLoop;

      It looks to me like your Tk version is a little old. What do you get if you run:

      perl -MTk -e "print $Tk::VERSION"

      If you have something lower than 804.027, you should consider upgrading.

      To handle changing the backgound colors of your script without needing to specify each widget, pass a pointer to the top level widget and recursively iterate over its children. Something like this. (replace the sub butone in your example script with these two subs.)

      sub butone { my $color = $diswindow->chooseColor( -initialcolor => $colour, -title => 'Choose color' ); if ($color) { $colour = $color; my ( $r, $g, $b ) = $colour =~ /\w{2}/g; for ( $r, $g, $b ) { $_ = hex $_; } my $foreground = ( $r + $g + $b < 400 ) ? '#ffffff' : '#000000 +'; change_colors( $diswindow, $colour, $foreground ); } } sub change_colors { my ( $widget, $color, $fg ) = @_; $widget->configure( -bg => $color ); { no warnings 'uninitialized'; eval( $widget->configure( -foreground => $fg ) ); } if ( my @children = $widget->children ) { change_colors( $_, $color, $fg ) for @children; } }

      Note that this also adjusts the foreground color to compensate for too dark or too light backgrounds.

        Thanks very much thundergnat... I have 800.024 for your perl -MTk -e "print $Tk::VERSION" command... Your script too is working, I can colour the window from the chooseColor thingy, and all are coloured. I'll have to take some time to get my head around it though. O... just to say the first time the window pops up it is still not all coloured but after the selection from the chooseColor thingy things are fine... No need to reply again... Thanks much...