in reply to Adding a Skin to a Tk widget

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;

[download]

Replies are listed 'Best First'.
Re^2: Adding a Skin to a Tk widget
by thundergnat (Deacon) on Nov 28, 2005 at 21:11 UTC

    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"

    [download]

    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;
    }
}

    [download]

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

[reply]
[d/l]
[select]
      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...
[reply]

In Section Seekers of Perl Wisdom