Method to take a Hex color value, such as FF9944, turn it to Decimal, chop down the color by X, and return the new color in Hex, as seen in my Scratchpad.
sub downhex {
# Coded by: Kage (Kage@DBXML.com) http://ss.dbmxl.com
# Copyright (C) 2002-2005 Kage, All Rights Reserved.
my ($hexcolor, $degrade) = @_;
my (@rgbarray, $digitcounter, $coltemp, $rgblowcount, $collabel, $pac
+kout, $coltemp2, $hexvalue);
$hexcolor =~ s/\#//;
for ($digitcounter=0; $digitcounter<3; $digitcounter++) {
$coltemp = substr($hexcolor, 2*$digitcounter, 2);
$rgbarray[$digitcounter] = (16 * hex(substr($coltemp, 0, 1)) + hex(s
+ubstr($coltemp, 1, 1)));
}
for ($rgblowcount=0; $rgblowcount<3; $rgblowcount++) {
if ($rgbarray[$rgblowcount] >= $degrade) {
$rgbarray[$rgblowcount] = ($rgbarray[$rgblowcount] - $degrade);
}
}
foreach $collabel (@rgbarray) {
if (($collabel >= 0) && ($collabel <= 255)) {
$packout = pack "c", $collabel;
$collabel = unpack "H2", $packout;
if (length($collabel) < 2) {
$collabel = "0".$collabel;
}
$coltemp2 .= $collabel;
} else {
$coltemp2 = "";
break; # Optional, though it won't work in Strict
}
}
if (length($coltemp2) == 6) {
$hexvalue = "#".$coltemp2;
}
return uc($hexvalue);
}
Re: Hex color degrader
by Aristotle (Chancellor) on Oct 13, 2002 at 11:01 UTC
|
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
}
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. | [reply] [Watch: Dir/Any] [d/l] |
|
#! 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> </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__
renders as
| 800000 | 808000 | 008000 | 008080 | 000080 | 808080 | c0c0c0 |
-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] [Watch: Dir/Any] [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
};
}
Makeshifts last the longest. | [reply] [Watch: Dir/Any] [d/l] |
Re: Hex color degrader
by BrowserUk (Patriarch) on Oct 13, 2002 at 04:54 UTC
|
It struck me that the way you have implemented your degrade, if one of the rgb value is less than the value by which you are degrading $rgbarray[$rgblowcount] >= $degrade;, it is left untouched. This seems wrong to me.
Say you had the rgb value
a bright purplish pink
and you degrade it by 128 (0x80) then using your algorithm it becomes
a mid-grey.
Wouldn't it be better to degrade all of the triplet evenly until they reach zero thereby maintaining the relative proportions of the three colours as long as possible?
Using my example above,
degraded by 128 becomes
a darker purple colour.
To that end, I offer...
#! perl -sw
use strict;
sub min{ $_[0]<$_[1] ? $_[0] : $_[1] }
sub degrade{
my ($rgb, $degr) = (hex(shift), pop);
$rgb -= min( $rgb&(0xff<<$_), $degr<<$_ ) for (0,8,16);
sprintf '%06x', $rgb;
}
my $rgb = "FF9944";
printf 'Degrading %6s by %3d gives %6s%s', $rgb, $_, degrade( $rgb, $_
+), $/
for (0x01, 0x0f, 0x10, 0x44, 0x80, 0xcc, 0xee, 0xf0);
__END__
C:\test>204824
Degrading FF9944 by 1 gives fe9843 |
Degrading FF9944 by 15 gives f08a35 |
Degrading FF9944 by 16 gives ef8934 |
Degrading FF9944 by 68 gives bb5500 |
Degrading FF9944 by 128 gives 7f1900 |
Degrading FF9944 by 204 gives 330000 |
Degrading FF9944 by 238 gives 110000 |
Degrading FF9944 by 240 gives 0f0000 |
Cor! Like yer ring! ... HALO dammit! ... 'Ave it yer way! Hal-lo, Mister la-de-da. ... Like yer ring! | [reply] [Watch: Dir/Any] [d/l] [select] |
•Re: Hex color degrader
by merlyn (Sage) on Oct 12, 2002 at 23:20 UTC
|
print hexdegrade("FF9944", 3);
sub hexdegrade {
my $hex = shift;
my $degrade = shift;
my $temp = pack "H*", $hex;
for (0..length($temp)-1) {
for (vec($temp, $_, 8)) {
$_ -= $degrade if $_ >= $degrade;
}
}
return unpack "H*", $temp;
}
-- Randal L. Schwartz, Perl hacker | [reply] [Watch: Dir/Any] [d/l] |
Re: Hex color degrader
by Kage (Scribe) on Oct 15, 2002 at 22:05 UTC
|
Oh shoot me down, why don't ye. :^P
Oh well, it isn't horrible work for a sort of 2 AM work..
Though I do see my mistake with leaving values less than the degrader untouched. I did this as a quick route-around due to the fact that it would return #000000 alot of times if the degrader was more than the value.
Oh well.
Oh poo. | [reply] [Watch: Dir/Any] |
|
|