in reply to Hex color degrader

The really correct way to do this is to subtract the given value from the largest cofficient, then multiply the smaller cofficients by the quotient of its difference. This way, all coefficients are decreased proportionally, so that unlike with BrowserUK's method the hue never changes, only the luminance. (Actually, it's not 100% correct either, but very close.) 
sub darken_hexrgb {
    my ($hexrgb, $darken) = @_;
    my @rgb = map hex, unpack "A2"x3, $hexrgb;

    my $max = (sort {$a <=> $b} @rgb)[-1];
    return "000000" if $max <= $darken;

    my $fact = ($max - $darken) / $max;
    return sprintf "%02X"x3, map { int($_ * $fact) } @rgb
}

[download]

That's what it looks like:

darken_hexrgb("FF9944", 8) = F79441
darken_hexrgb("FF9944", 16) = EF8F3F
darken_hexrgb("FF9944", 32) = DF853B
darken_hexrgb("FF9944", 48) = CF7C37
darken_hexrgb("FF9944", 64) = BF7232
darken_hexrgb("FF9944", 80) = AF692E
darken_hexrgb("FF9944", 96) = 9F5F2A
darken_hexrgb("FF9944", 112) = 8F5526
darken_hexrgb("FF9944", 128) = 7F4C21
darken_hexrgb("FF9944", 160) = 5F3919
darken_hexrgb("FF9944", 176) = 4F2F15
darken_hexrgb("FF9944", 192) = 3F2510
darken_hexrgb("FF9944", 208) = 2F1C0C
darken_hexrgb("FF9944", 224) = 1F1208

(Layout shamelessly stolen from BrowserUK.)

Makeshifts last the longest.

Replies are listed 'Best First'.
Re: Re: Hex color degrader
by BrowserUk (Patriarch) on Oct 13, 2002 at 16:30 UTC

    Agreed. That makes perfect sense. However, why not take it one step further and make the function darken or lighten as required. 

    #! perl -sw
use strict;
local $\=$/;

sub Dlighken {
  return sprintf '%02x'x3,
      map{ ($_ *= 1+$_[1]) > 0xff ? 0xff : $_  }
      map hex, unpack 'A2'x3, $_[0];
}

my @colors = qw/800000 808000 008000 008080 000080 808080 c0c0c0/;

print '<table>';
print '<tr><td>&nbsp;</td>', map{ 
    '<th>'.$_.'</th>' 
} @colors, '</tr>'; 

for my $scale ( -5 .. +5 ) {
    print '<tr><td>'.($scale/10).'</td>';
    print '<td bgcolor="#', $_, '">', $_, '</td>' 
        for map{ Dlighken($_, $scale/10) } @colors;
    print '</tr>';
}
print '</table>';
__END__

    [download]

    renders as
     800000808000008000008080000080808080c0c0c0
    -0.5 400000 404000 004000 004040 000040 404040 606060
    -0.4 4c0000 4c4c00 004c00 004c4c 00004c 4c4c4c 737373
    -0.3 590000 595900 005900 005959 000059 595959 868686
    -0.2 660000 666600 006600 006666 000066 666666 999999
    -0.1 730000 737300 007300 007373 000073 737373 acacac
    0 800000 808000 008000 008080 000080 808080 c0c0c0
    0.1 8c0000 8c8c00 008c00 008c8c 00008c 8c8c8c d3d3d3
    0.2 990000 999900 009900 009999 000099 999999 e6e6e6
    0.3 a60000 a6a600 00a600 00a6a6 0000a6 a6a6a6 f9f9f9
    0.4 b30000 b3b300 00b300 00b3b3 0000b3 b3b3b3 ffffff
    0.5 c00000 c0c000 00c000 00c0c0 0000c0 c0c0c0 ffffff

    Cor! Like yer ring! ... HALO dammit! ... 'Ave it yer way! Hal-lo, Mister la-de-da. ... Like yer ring!
[reply]
[d/l]
      Not a bad point, but I'd stick to having a brightness value passed, not a scaling factor. It's a bit easier to have a rough idea of the outcome that way IMO. 
      sub add_to_hexrgb {
    my @rgb = map hex, unpack "A2"x3, $_[0];
    my $max = (sort {$a <=> $b} @rgb)[-1];
    my $smax = $max + $_[1];

    return
        $smax < 0 ? "000000" :
        $smax > 255 ? "FFFFFF" :
        do {
            my $fact = ($max + $sumd) / $max;
            sprintf "%02X"x3, map { int($_ * $fact) } @rgb
        };
}

      [download]

      Makeshifts last the longest.

[reply]
[d/l]

In Section Cool Uses for Perl