home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / auto / Tk / Widget / Darken.al < prev    next >
Encoding:
Text File  |  1997-08-10  |  818 b   |  30 lines
  1. # NOTE: Derived from blib\lib\Tk\Widget.pm.  Changes made here will be lost.
  2. package Tk::Widget;
  3.  
  4. # tkDarken --
  5. # Given a color name, computes a new color value that darkens (or
  6. # brightens) the given color by a given percent.
  7. #
  8. # Arguments:
  9. # color - Name of starting color.
  10. # perecent - Integer telling how much to brighten or darken as a
  11. # percent: 50 means darken by 50%, 110 means brighten
  12. # by 10%.
  13. sub Darken
  14. {
  15.  my ($w,$color,$percent) = @_;
  16.  my @l = $w->rgb($color);
  17.  my $red = $l[0]/256;
  18.  my $green = $l[1]/256;
  19.  my $blue = $l[2]/256;
  20.  $red = int($red*$percent/100);
  21.  $red = 255 if ($red > 255);
  22.  $green = int($green*$percent/100);
  23.  $green = 255 if ($green > 255);
  24.  $blue = int($blue*$percent/100);
  25.  $blue = 255 if ($blue > 255);
  26.  sprintf("#%02x%02x%02x",$red,$green,$blue)
  27. }
  28.  
  29. 1;
  30.