%
'color Functions by Gus Mueller
'these perform math on html hex color values to
'achieve various color effects and manipulations
function colorindex(strIn)
select case strIn
case "00"
ColorIndex=0
case "33"
ColorIndex=1
case "66"
ColorIndex=2
case "99"
ColorIndex=3
case "cc"
ColorIndex=4
case else
ColorIndex=5
end select
end function
function indextocolor(strIn)
select case strIn
case 0
indextocolor="00"
case 1
indextocolor="33"
case 2
indextocolor="66"
case 3
indextocolor="99"
case 4
indextocolor="cc"
case else
indextocolor="ff"
end select
end function
function coloradd(strIn1, strIn2)
dim intSpecificColorParse
strIn1=colorsafe(strIn1)
strIn2=colorsafe(strIn2)
coloradd=""
for intSpecificColorParse=0 to 2
if ColorIndex(ColorParse(strIn1, intSpecificColorParse))+ColorIndex(ColorParse(strIn2, intSpecificColorParse)) =>0 and ColorIndex(ColorParse(strIn1, intSpecificColorParse))+ColorIndex(ColorParse(strIn2, intSpecificColorParse))<=5 then
coloradd=coloradd & indextocolor(ColorIndex(ColorParse(strIn1, intSpecificColorParse))+ColorIndex(ColorParse(strIn2, intSpecificColorParse)))
else
coloradd=coloradd & ColorParse(strIn1, intSpecificColorParse)
end if
next
end function
function coloropposite(strIn)
dim intSpecificColorParse
strIn=colorsafe(strIn)
coloropposite=""
for intSpecificColorParse=0 to 2
coloropposite=coloropposite & indextocolor(5-ColorIndex(ColorParse(strIn, intSpecificColorParse)))
next
end function
function textcolor(byval strIn)
'comes back with either black or white depending on the background color passed in
dim colOut
strIn=colorsafe(strIn)
colOut="ffffff"
if brightvalue(strIn)>8 then colOut="000000"
textcolor=colOut
end function
function hueopposite(strIn, colIn)
dim intSpecificColorParse
strIn=colorsafe(strIn)
hueopposite=""
for intSpecificColorParse=0 to 2
if intSpecificColorParse=colIn then
hueopposite=hueopposite & indextocolor(ColorIndex(ColorParse(strIn, 5-intSpecificColorParse)))
end if
next
end function
function level(byval strIn)
dim intValue, intSpecificColorParse
'returns 0 if the colIn is generally dark, 1 if it is generally light
strIn=colorsafe(strIn)
intValue=0
for intSpecificColorParse=0 to 2
intValue=intValue+ColorIndex(ColorParse(strIn))
next
if intValue>8 then
level=1
else
level=0
end if
end function
function BrightValue(strIn)
dim intSpecificColorParse
'returns the overall brightness of a colIn
strIn=colorsafe(strIn)
for intSpecificColorParse=0 to 2
BrightValue=BrightValue + ColorIndex(ColorParse(strIn, intSpecificColorParse))
next
end function
function colorsubtract(strIn1, strIn2)
dim intSpecificColorParse
strIn1=colorsafe(strIn1)
strIn2=colorsafe(strIn2)
colorsubtract=""
for intSpecificColorParse=0 to 2
'response.write("
"& ColorIndex(ColorParse(strIn1, intSpecificColorParse))-ColorIndex(ColorParse(strIn2, intSpecificColorParse)) & "*")
if ColorIndex(ColorParse(strIn1, intSpecificColorParse))-ColorIndex(ColorParse(strIn2, intSpecificColorParse)) =>0 and ColorIndex(ColorParse(strIn1, intSpecificColorParse))-ColorIndex(ColorParse(strIn2, intSpecificColorParse))<=5 then
colorsubtract=colorsubtract & indextocolor(ColorIndex(ColorParse(strIn1, intSpecificColorParse))-ColorIndex(ColorParse(strIn2, intSpecificColorParse)))
else
colorsubtract=colorsubtract & ColorParse(strIn1, intSpecificColorParse)
end if
next
end function
function darker(strIn, intValue)
dim intSpecificColorParse
strIn=colorsafe(strIn)
darker=""
for intSpecificColorParse=0 to 2
if ColorIndex(ColorParse(strIn, intSpecificColorParse))-intValue =>0 and ColorIndex(ColorParse(strIn, intSpecificColorParse))-intValue<=5 then
darker=darker & indextocolor(ColorIndex(ColorParse(strIn, intSpecificColorParse))-intValue)
else
darker=darker & ColorParse(strIn, intSpecificColorParse)
end if
next
end function
function subtlecolor(strIn)
'this function steps the color one brightness level towards a subtlely different color
'response.write strIn
strIn=colorsafe(strIn)
if brightvalue(strIn)<4 then
subtlecolor=lighter(strIn, 1)
elseif brightvalue(strIn)>=4 and brightvalue(strIn)< 8 then
subtlecolor=lighter(strIn, 1)
elseif brightvalue(strIn)>=8 and brightvalue(strIn)< 12 then
subtlecolor=lighter(strIn, 1)
elseif brightvalue(strIn)>=12 then
subtlecolor=lighter(strIn, -1)
end if
'response.write subtlecolor
end function
function towardsmiddle(strIn)
'this function steps the color one brightness level towards neutral grey, either darker or lighter
strIn=colorsafe(strIn)
if brightvalue(strIn)>8 then
towardsmiddle=darker(strIn, 1)
else
towardsmiddle=darker(strIn, -1)
end if
end function
function saturate(strIn)
'this function does not work yet
strIn=colorsafe(strIn)
thingshappened=true
saturate=""
store=0
colorstore=0
bump=0
for intSpecificColorParse=0 to 2
for r=0 to intSpecificColorParse
if ColorParse(strIn, r)=ColorParse(strIn, intSpecificColorParse) then
bump=bump+1
end if
next
if ColorIndex(ColorParse(strIn, intSpecificColorParse))>colorstore then
store=intSpecificColorParse
colorstore=ColorIndex(ColorParse(strIn, intSpecificColorParse))
end if
next
if bump=6 then thingshappened=false
'response.write (bump)
doit=0
for intSpecificColorParse=0 to 2
if thingshappened then
if intSpecificColorParse<>store then
if ColorIndex(ColorParse(strIn, intSpecificColorParse))>0 then
thiscolor=ColorIndex(ColorParse(strIn, intSpecificColorParse))-1
end if
else
if ColorIndex(ColorParse(strIn, intSpecificColorParse))<4 then
thiscolor=ColorIndex(ColorParse(strIn, intSpecificColorParse))+2
elseif ColorIndex(ColorParse(strIn, intSpecificColorParse))<5 then
thiscolor=ColorIndex(ColorParse(strIn, intSpecificColorParse))+1
else
thiscolor=ColorIndex(ColorParse(strIn, intSpecificColorParse))
end if
end if
saturate=saturate & indextocolor(thiscolor)
else
saturate=strIn
end if
next
end function
function lighter(strIn, intValue)
dim intSpecificColorParse
strIn=colorsafe(strIn)
lighter=""
for intSpecificColorParse=0 to 2
if ColorIndex(ColorParse(strIn, intSpecificColorParse))+intValue =>0 and ColorIndex(ColorParse(strIn, intSpecificColorParse))+intValue <=5 then
lighter=lighter & indextocolor(ColorIndex(ColorParse(strIn, intSpecificColorParse))+intValue)
else
lighter=lighter & ColorParse(strIn, intSpecificColorParse)
end if
next
end function
function lighterhue(strIn, colIn, intValue)
dim intSpecificColorParse, colPotential
strIn=colorsafe(strIn)
lighterhue=""
for intSpecificColorParse=0 to 2
if intSpecificColorParse=colIn then
colPotential=ColorIndex(ColorParse(strIn, colIn))+intValue
if colPotential>5 then colPotential=5
if colPotential<0 then colPotential=0
lighterhue=lighterhue & indextocolor(colPotential)
else
lighterhue=lighterhue & ColorParse(strIn, intSpecificColorParse)
end if
next
end function
function lighterotherhues(strIn, colIn, intValue)
dim intSpecificColorParse
strIn=colorsafe(strIn)
lighterotherhues=""
for intSpecificColorParse=0 to 2
if ColorIndex(ColorParse(strIn, colIn))+intValue=>0 and ColorIndex(ColorParse(strIn, colIn))+intValue<=5 and intSpecificColorParse<>colIn then
lighterotherhues=lighterotherhues & indextocolor(ColorIndex(ColorParse(strIn, colIn))+intValue)
else
lighterotherhues=lighterotherhues & ColorParse(strIn, intSpecificColorParse)
end if
next
end function
function darkerhue(strIn, colIn, intValue)
dim intSpecificColorParse
strIn=colorsafe(strIn)
darkerhue=""
for intSpecificColorParse=0 to 2
if ColorIndex(ColorParse(strIn, colIn))-intValue=>0 and ColorIndex(ColorParse(strIn, colIn))-intValue<=5 and intSpecificColorParse=colIn then
darkerhue=darkerhue & indextocolor(ColorIndex(ColorParse(strIn, colIn))-intValue)
else
darkerhue=darkerhue & ColorParse(strIn, intSpecificColorParse)
end if
next
end function
function darkerotherhues(strIn, colIn, intValue)
dim intSpecificColorParse
strIn=colorsafe(strIn)
darkerotherhues=""
for intSpecificColorParse=0 to 2
if ColorIndex(ColorParse(strIn, colIn))-intValue=>0 and ColorIndex(ColorParse(strIn, colIn))-intValue<=5 and intSpecificColorParse<>colIn then
darkerotherhues=darkerotherhueses & indextocolor(ColorIndex(ColorParse(strIn, colIn))-intValue)
else
darkerotherhues=darkerotherhues & ColorParse(strIn, intSpecificColorParse)
end if
next
end function
function ColorParse(byval strIn, byval intColor)
'returns a colorvalue
select case cint(intColor)
case 0
ColorParse=left(strIn, 2)
case 1
ColorParse=mid(strIn, 3, 2)
case else
ColorParse=mid(strIn, 5, 2)
end select
end function
function ColorRotateLeft(strIn)
dim colRed, colGreen, colBlue, colHold
colRed=left(strIn, 2)
colGreen=mid(strIn, 3, 2)
colBlue=right(strIn, 2)
colHold=colRed
colRed=colGreen
colGreen=colBlue
colBlue=colHold
ColorRotateLeft=colRed&colGreen&colBlue
end function
function RedGreenSwap(strIn)
dim colRed, colGreen, colBlue, colHold
colRed=left(strIn, 2)
colGreen=mid(strIn, 3, 2)
colBlue=right(strIn, 2)
colHold=colRed
colRed=colGreen
colGreen=colHold
RedGreenSwap= colRed & colGreen & colBlue
end function
function RedBlueSwap(strIn)
dim colRed, colGreen, colBlue, colHold
colRed=left(strIn, 2)
colGreen=mid(strIn, 3, 2)
colBlue=right(strIn, 2)
colHold=colRed
colRed=colBlue
colBlue=colHold
RedBlueSwap=colRed & colGreen & colBlue
end function
function GreenBlueSwap(strIn)
dim colRed, colGreen, colBlue, colHold
colRed=left(strIn, 2)
colGreen=mid(strIn, 3, 2)
colBlue=right(strIn, 2)
colHold=colBlue
colBlue=colGreen
colGreen=colHold
GreenBlueSwap=colRed & colGreen & colBlue
end function
function ColorRotateRight(strIn)
dim colRed, colGreen, colBlue, colHold
colRed=left(strIn, 2)
colGreen=mid(strIn, 3, 2)
colBlue=right(strIn, 2)
colHold=colBlue
colBlue=colGreen
colGreen=colRed
colRed=colHold
ColorRotateRight=colRed&colGreen&colBlue
end function
function dec(byval strIn)
'converts a hex expression into its decimal equivalent
dim strHex, arrHex, intLetter, intPlace, intAccumulate, intOut, bwlDone, intHexValue
strHex="0,1,2,3,4,5,6,7,8,9,a,b,c,d,e,f"
arrHex=split(strHex, ",")
for intLetter=1 to len(strIn)
intScale = 16 ^ ( len(strIn) - intLetter)
intHexValue=0
intOut=0
bwlDone=false
do until intHexValue>15 or bwlDone
'response.write intHexValue & "
"
if mid(strIn, intLetter, 1)=arrHex(intHexValue) then
intOut = intHexValue
bwlDone = true
end if
intHexValue = intHexValue + 1
loop
'response.write intOut & " " & intScale & "
"
intAccumulate=intAccumulate + intOut * intScale
next
dec=intAccumulate
end function
function colorsafe(byval strIn)
'makes a color-unsafe color into the closest matching color-safe color
Dim strAccumulate, intSpecificColorParse, strSpecificColor, intSpecificColor
colorsafe=""
strIn=replace(strIn, "#", "")
if len(strIn)>6 then strIn=left(strIn, 6)
if len(strIn)<6 then
do until len(strIn)=6
strIn=left(strIn, 6) & "0"
loop
end if
strIn=lcase(strIn)
strAccumulate=""
for intSpecificColorParse=0 to 2
strSpecificColor= ColorParse(strIn, intSpecificColorParse)
'if colorsafe
intSpecificColor=dec(strSpecificColor)
if intSpecificColor<=26 then
strClosest="00"
elseif intSpecificColor > 26 and intSpecificColor<=75 then
strClosest="33"
elseif intSpecificColor > 75 and intSpecificColor<=125 then
strClosest="66"
elseif intSpecificColor > 125 and intSpecificColor<=175 then
strClosest="99"
elseif intSpecificColor > 175 and intSpecificColor<=225 then
strClosest="cc"
else
strClosest="ff"
end if
strAccumulate=strAccumulate & strClosest
next
colorsafe=strAccumulate
end function
%>