'**************************************
' Name: Adjust a GIF's Hue/Sat/Lum
' Description:This code adjusts the Hue,
' Saturation and Luminosity of any gif fil
' e on the fly! No component needed, it's
' just asp code.
live demo: http://www.cwolves.com/testing/coloradj.html
' By: Mark Kahn
'
' Inputs:querystring inputs:
img (image path)
hue (-180 --> 180)
sat (-100 --> 100)
lum (-100 --> 100)
'
' Returns:your new gif
'
'This code is copyrighted and has ' limited warranties.Please see http://w
' ww.Planet-Source-Code.com/vb/scripts/Sho
' wCode.asp?txtCodeId=8626&lngWId;=4 'for details. '**************************************
<%
response.contenttype = "image/gif"
src= request.querystring("Img")
Hue= request.querystring("Hue")
Sat= request.querystring("Sat")
Lum= request.querystring("Lum")
function dofix(val)
if val > 239 Then
val = val - 239
val = dofix(val)
ElseIf val < 0 Then
val = val + 239
val = dofix(val)
End if
dofix = val
End function
function dofix2(val)
if val > 239 Then
dofix2 = 239
ElseIf val < 0 Then
dofix2 = 0
Else
dofix2 = val
End if
End function
function hexval(char)
Select Case char
Case "0": hexval = 0
Case "1": hexval = 1
Case "2": hexval = 2
Case "3": hexval = 3
Case "4": hexval = 4
Case "5": hexval = 5
Case "6": hexval = 6
Case "7": hexval = 7
Case "8": hexval = 8
Case "9": hexval = 9
Case "A": hexval = 10
Case "B": hexval = 11
Case "C": hexval = 12
Case "D": hexval = 13
Case "E": hexval = 14
Case "F": hexval = 15
End Select
End function
function Ascii(color)
out = ""
For i = 0 To 2
this = mid(color, i*2+1, 2)
tmp = 16*hexval(left(this, 1)) + hexval(right(this, 1))
out = out & chr(tmp)
Next
Ascii = out
End function
function stb(tString)
Dim I, B
For I=1 To len(tString)
B = B & ChrB(Asc(Mid(tString,I,1)))
Next
stb = B
End function
function RGBtoHSL(ByVal Red, ByVal Green, ByVal Blue, ByRef Hue, ByRef Sat, ByRef Lum)
pRed= Red / 255
pGreen = Green / 255
pBlue = Blue / 255
if pRed > pGreen Then
if pRed > pBlue Then pMax = pRed Else pMax = pBlue
ElseIf pGreen > pBlue Then
pMax = pGreen
Else
pMax = pBlue
End if
if pRed < pGreen Then
if pRed < pBlue Then pMin = pRed Else pMin = pBlue
ElseIf pGreen < pBlue Then
pMin = pGreen
Else
pMin = pBlue
End if
pLum = (pMax + pMin) / 2
if pMax = pMin Then
pSat = 0
pHue = 0
Else
if pLum < 0.5 Then
pSat = (pMax - pMin) / (pMax + pMin)
Else
pSat = (pMax - pMin) / (2 - pMax - pMin)
End if
Select Case pMax
Case pRed
pHue = (pGreen - pBlue) / (pMax - pMin)
Case pGreen
pHue = 2 + (pBlue - pRed) / (pMax - pMin)
Case pBlue
pHue = 4 + (pRed - pGreen) / (pMax - pMin)
End Select
End if
Hue = pHue * 239 \ 6
if Hue < 0 Then Hue = Hue + 240
Sat = Int(pSat * 239)
Lum = Int(pLum * 239)
End function
function HSLtoRGB(ByRef Red, ByRef Green, ByRef Blue, ByVal Hue, ByVal Sat, ByVal Lum)
Dimtemp3()
ReDim temp3(3)
pHue = Hue / 239
pSat = Sat / 239
pLum = Lum / 239
if pSat = 0 Then
pRed = pLum
pGreen = pLum
pBlue = pLum
Else
if pLum < 0.5 Then
temp2 = pLum * (1 + pSat)
Else
temp2 = pLum + pSat - pLum * pSat
End if
temp1 = 2 * pLum - temp2
temp3(0) = pHue + 1 / 3
temp3(1) = pHue
temp3(2) = pHue - 1 / 3
For n = 0 To 2
if temp3(n) < 0 Then temp3(n) = temp3(n) + 1
if temp3(n) > 1 Then temp3(n) = temp3(n) - 1
if 6 * temp3(n) < 1 Then
temp3(n) = temp1 + (temp2 - temp1) * 6 * temp3(n)
Else
if 2 * temp3(n) < 1 Then
temp3(n) = temp2
Else
if 3 * temp3(n) < 2 Then temp3(n) = temp1 + (temp2 - temp1) * ((2 / 3) - temp3(n)) * 6 Else temp3(n) = temp1
End if
End if
Next
pRed= temp3(0)
pGreen = temp3(1)
pBlue = temp3(2)
End if
Red= Int(pRed * 255)
Green = Int(pGreen * 255)
Blue = Int(pBlue * 255)
End function
if not(src = "" or Hue = "") Then
Set FSO = server.createobject("Scripting.FileSystemObject")
Set file = FSO.OpenTextFile(server.mappath(src), 1, false)
StartData = file.read(13)
TableSize = asc(mid(StartData, 11, 1))
tSize = 1
if (TableSize AND 1) = 1 Then tSize = tSize + 1
if (TableSize AND 2) = 2 Then tSize = tSize + 2
if (TableSize AND 4) = 4 Then tSize = tSize + 4
tSize = 2^tSize
ColorData = file.read(tSize*3)
EndData= ""
Do While Not file.atendofstream
EndData = EndData & file.read(100)
Loop
file.close: Set file = nothing
Set FSO = nothing
NewColorData = ""
For i = 1 To len(ColorData)-2 STEP 3
R = asc(mid(colordata, i+0, 1))
G = asc(mid(colordata, i+1, 1))
B = asc(mid(colordata, i+2, 1))
H = 0
L = 0
S = 0
call RGBtoHSL(R, G, B, H, S, L)
H = H + (239/360*Hue)
if Sat < 0 Then S = S + Sat * .01 * (S) Else S = S + Sat * .01 * (239-S)
if Lum < 0 Then L = L + Lum * .01 * (L) Else L = L + Lum * .01 * (239-L)
h = dofix(h)
s = dofix2(s)
l = dofix2(l)
call HSLtoRGB(R, G, B, H, S, L)
NewColorData = NewColorData & chr(R) & chr(G) & chr(B)
Next
response.binarywrite stb(StartData & NewColorData & EndData)
End if
%> |
