<% '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 %>