[Israel.pm] Perl GUis

Felix Liberman felix.liberman at gmail.com
Sat Dec 9 13:00:59 PST 2006


Want to learn how to recolor all widgets in Tk? Ask me how ;-)

############################# service module:
my $mwPalette='';
my %palette=(-background=>'gray90',-foreground=>'black');
my $mw=''; # copied from Main module during SetMainPalette

sub SetMainPalette
{
  $mw = shift;
  die "$0 SetMainPalette - ERROR: <$mw> is wrong type or missing\n"
    unless ref $mw;
  my ($bg_color,$fg_color) = @_;
  $mwPalette = $mw->Palette;

  my %new = (background=>$bg_color,foreground=>$fg_color);
  $mw->RecolorTree(\%new);
  # Save the options in the global variable Tk::Palette, for use the
  # next time we change the options.
  foreach my $option (keys %new)
  {
    $mwPalette->{$option} = $new{$option};
    $palette{"-$option"} = $new{$option};
  }
  &Coloring($mw);
}

sub GetMainPalette
{
  die "$0 GetMainPalette - ERROR: <$mw> is wrong type or missing\n"
    unless ref $mw;
  $mwPalette = $mw->Palette;
  $mwPalette->{'background'} = 'gray90' unless $mwPalette->{'background'};
  $mwPalette->{'foreground'} = 'black'  unless $mwPalette->{'foreground'};
  return ($mwPalette->{'background'},$mwPalette->{'foreground'});
}

# this is a recolor trick borrowed from Perl/Tk hacking archive:
sub Coloring
{
  my ($widget)=@_;
  die "$0 FATAL ERROR - empty palette!\n"
    unless length (%palette);
  eval '$widget->configure(%palette)';
  foreach my $child ($widget->children)
  {
    &Coloring($child);
  }
}

############################# Main:
my $mw = MainWindow->new();
&SetMainPalette($mw,'gray90','black');
...

# get bg_color and fg_color from some source (user/ini-file/etc.)
...
&SetMainPalette($mw,$bg_color,$fg_color);

##############################

Main trade secret here is a parameters list without 'minus' prefix for keys
'background' and 'foreground'.

Regards,

   ~Felix_


On 12/9/06, perl-request at perl.org.il <perl-request at perl.org.il> wrote:
> Date: Fri, 8 Dec 2006 13:54:44 +0200
> From: "Levenglick Dov-RM07994" <dovl at freescale.com>
> Subject: Re: [Israel.pm] Perl GUis
> To: "Perl in Israel" <perl at perl.org.il>
> Message-ID:
>         <36028CF345D5CA40AC0494886B174E6DAAFD60 at zil05exm12.fsl.freescale.net>
> Content-Type: text/plain;       charset="us-ascii"
>
> There is absolutely nothing to prevent you from making you Tk GUIs
> colorful. Use the background color options.
>
>
>
> Best Regards,
> Dov Levenglick



More information about the Perl mailing list