PerlTk - changing background colours with chooseColor Dialog

Author

changing background colours with chooseColor Dialog

Nath

2004-08-16, 8:58 am

I would like to implement a simple colour scheme where the user can change
the colours associated with the different widgets.

This may be a simple problem, but my brain hurts!

At the moment my text widgets have their background defined using the
following option and and the associated colour staored in a hash:

-background => $colour_scheme{'text_bg'},

I would like to be able to call the chooseColor dialog to be able to change
the background colour of all my text widgets, currently implemented using:

my $prefs_gui_text_bg_be = $prefs_page_gui_f->Button(
-text => 'Select Text Background Colour',
-font => $gui_font,
-width => 10,
-command => sub { $colour_scheme{'text_bg'} =
$top->chooseColor(-title => 'Select Application Text Background
Colour', -initialcolor => $colour_scheme{'text_bg'}) },
);

However this doesn't seem to work, i'm sure i'm missing something obvious -
please tell me! :o)

Thanks
Nathan

Ala Qumsieh

2004-08-16, 3:57 pm

Nath wrote:
> I would like to implement a simple colour scheme where the user can change
> the colours associated with the different widgets.

The 'Color Picker' demo that comes with Perl/Tk does exactly that. Just
type 'widget' at your command prompt, and scroll down to 'Common Dialogs'.

--Ala

Slaven Rezic

2004-08-16, 3:57 pm

"Nath" <DON'T_SEND_ME@TRIPE_TO_MY_IN.BOX> wrote in message news:<41207863$0$27968$afc38c87@news.ukonline.co.uk>...
> I would like to implement a simple colour scheme where the user can change
> the colours associated with the different widgets.
>
> This may be a simple problem, but my brain hurts!
>
> At the moment my text widgets have their background defined using the
> following option and and the associated colour staored in a hash:
>
> -background => $colour_scheme{'text_bg'},
>
> I would like to be able to call the chooseColor dialog to be able to change
> the background colour of all my text widgets, currently implemented using:
>
> my $prefs_gui_text_bg_be = $prefs_page_gui_f->Button(
> -text => 'Select Text Background Colour',
> -font => $gui_font,
> -width => 10,
> -command => sub { $colour_scheme{'text_bg'} =
> $top->chooseColor(-title => 'Select Application Text Background
> Colour', -initialcolor => $colour_scheme{'text_bg'}) },
> );
>
> However this doesn't seem to work, i'm sure i'm missing something obvious -
> please tell me! :o)

This won't work because -background uses fixed scalar values, not references.

Normally it's easier to use the option database:

$top->optionAdd("*background", $bg);

Regards,
Slaven

Matthew Braid

2004-08-17, 3:56 am

> This won't work because -background uses fixed scalar values, not references.
>
> Normally it's easier to use the option database:
>
> $top->optionAdd("*background", $bg);
>
> Regards,
> Slaven

I thought that only worked if the widgets hadn't been built yet - it won't
modify the background colour of existing widgets?

You could recursively redo the background like:

sub reconfigure {
my ($widget, @recon) = @_;
eval {$widget->configure(@recon)};
for my $child ($widget->children) {
reconfigure($child, @recon);
}
}
reconfigure($top, -background => 'red');

The eval is just in case you're passing a reconfigure pair that is not supported
by all widgets (like -state). This leads to a slight problem - if you passed
something like:

reconfigure($top, -arcane => 'magic', -background => 'red');

the fact that -arcane is probably not supported will probably stop the
-background flag from working (probably :) ). That can be fixed by:

sub reconfigure {
my ($widget, %recon) = @_;
for my $rec (keys %recon) {
eval {$widget->configure($rec => $recon{$rec})};
}
for my $child ($widget->children) {
reconfigure($child, %recon);
}
}
reconfigure($top, -arcane => 'magic', -background => 'red');

Slaven Rezic

2004-08-17, 8:57 pm

Matthew Braid <mb@uq.net.au.invalid> writes:

>
> I thought that only worked if the widgets hadn't been built yet - it
> won't modify the background colour of existing widgets?

Ah, sorry, you're right...

>
> You could recursively redo the background like:
>
> sub reconfigure {
> my ($widget, @recon) = @_;
> eval {$widget->configure(@recon)};
> for my $child ($widget->children) {
> reconfigure($child, @recon);
> }
> }
> reconfigure($top, -background => 'red');
>
> The eval is just in case you're passing a reconfigure pair that is not
> supported by all widgets (like -state). This leads to a slight problem
> - if you passed something like:
>
> reconfigure($top, -arcane => 'magic', -background => 'red');
>
> the fact that -arcane is probably not supported will probably stop the
> -background flag from working (probably :) ). That can be fixed by:
>
> sub reconfigure {
> my ($widget, %recon) = @_;
> for my $rec (keys %recon) {
> eval {$widget->configure($rec => $recon{$rec})};
> }
> for my $child ($widget->children) {
> reconfigure($child, %recon);
> }
> }
> reconfigure($top, -arcane => 'magic', -background => 'red');

Another way to reconfigure resusively is to use the Walk method:

$top->Walk(sub {
eval { $_->configure(... => ...) };
});

There's also the convenience method RecolorTree (I think also
undocumented):

$top->RecolorTree({ background => ...,
foreground => ...
});

Regards,
Slaven

--
Slaven Rezic - slaven <at> rezic <dot> de
BBBike - route planner for cyclists in Berlin
WWW version: http://www.bbbike.de
Perl/Tk version for Unix and Windows: http://bbbike.sourceforge.net

Sponsored Links