Quick Search for:  in language:    
code,adjusts,Saturation,Luminosity,file,compo
   Code/Articles » |  Newest/Best » |  Community » |  Jobs » |  Other » |  Goto » | 
CategoriesSearch Newest CodeCoding ContestCode of the DayAsk A ProJobsUpload
ASP/ VbScript Stats

 Code: 203,988. lines
 Jobs: 110. postings

 How to support the site

 
Sponsored by:

 
You are in:
 
Login


 

 


Latest Code Ticker for ASP/ VbScript.
aZoaPeS
By Simeon Albertson on 1/20


Move Window , Funs Stuff
By Jareh Ali Mohamed H. Al-Malki on 1/19


Click here to see a screenshot of this code!Rapid Classified v2.0
By Gurgen Alaverdian on 1/17

(Screen Shot)

Click here to see a screenshot of this code!Gallery Image with Zoom
By Marcelo Valle Franco on 1/12

(Screen Shot)

Click here to see a screenshot of this code!ASP Photo Competition
By Saul Bryan on 1/12

(Screen Shot)

Execute DTS package
By Himadrish Laha on 1/12


Connecting to a MySQL with ADO, DAO and RDO
By Ahmed Magdy Ezzeldin on 1/11


Automatic Form Insertion To Database
By Yasar Bayar on 1/11


Click here to see a screenshot of this code!Find Closest Physical Location (based on zip code, etc)
By Mark Kahn on 1/11

(Screen Shot)

Click here to put this ticker on your site!


Add this ticker to your desktop!


Daily Code Email
To join the 'Code of the Day' Mailing List click here!

Affiliate Sites



 
 
   

Adjust a GIF's Hue/Sat/Lum

Print
Email
 
VB icon
Submitted on: 11/17/2003 5:24:56 PM
By: Mark Kahn  
Level: Advanced
User Rating: By 6 Users
Compatibility:ASP (Active Server Pages)

Users have accessed this code 1009 times.
 
(About the author)
 
     This code adjusts the Hue, Saturation and Luminosity of any gif file on the fly! No component needed, it's just asp code. live demo: http://www.cwolves.com/testing/coloradj.html Live site using this: http://www.cwolves.com/home.asp?hue=0&sat;=0&lum;=0&con;=0&red;=true&green;=true&blue;=true&invert;=false play with all the querystring values in that link.
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
 
Terms of Agreement:   
By using this code, you agree to the following terms...   
1) You may use this code in your own programs (and may compile it into a program and distribute it in compiled format for languages that allow it) freely and with no charge.   
2) You MAY NOT redistribute this code (for example to a web site) without written permission from the original author. Failure to do so is a violation of copyright laws.   
3) You may link to this code from another website, but ONLY if it is not wrapped in a frame. 
4) You will abide by any additional copyright restrictions which the author may have placed in the code or code's description.

    '**************************************
    ' 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
    Live site using this:
    http://www.cwolves.com/home.asp?hue=0&sat;=0&lum;=0&con;=0&red;=true&green;=true&blue;=true&invert;=false
    play With all the querystring values in that link.
    ' 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)
    	Dim temp3()
    	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
    %>


Other 12 submission(s) by this author

 

 
Report Bad Submission
Use this form to notify us if this entry should be deleted (i.e contains no code, is a virus, etc.).
Reason:
 
Your Vote!

What do you think of this code(in the Advanced category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor See Voting Log
 
Other User Comments
11/18/2003 3:23:47 AM:
Great code!
All we need is the 
ability to resize the gif file. This it 
is perfect...
;)Lars
Keep the Planet clean! If this comment was disrespectful, please report it:
Reason:

 
11/18/2003 9:11:43 AM:Mark Kahn
I'm working on the resize one...since 
the lzw patent expired and I'm allowed 
to now  :-)
Hopefully within a few 
months I'll have a full-featured 
asp-only gif editor.  hehe.
Keep the Planet clean! If this comment was disrespectful, please report it:
Reason:

 
11/24/2003 3:30:33 AM:
Awesome code. Now, how about the RGB 
options like in your example?
Keep the Planet clean! If this comment was disrespectful, please report it:
Reason:

 
Add Your Feedback!
Note:Not only will your feedback be posted, but an email will be sent to the code's author in your name.

NOTICE: The author of this code has been kind enough to share it with you.  If you have a criticism, please state it politely or it will be deleted.

For feedback not related to this particular code, please click here.
 
Name:
Comment:

 

Categories | Articles and Tutorials | Advanced Search | Recommended Reading | Upload | Newest Code | Code of the Month | Code of the Day | All Time Hall of Fame | Coding Contest | Search for a job | Post a Job | Ask a Pro Discussion Forum | Live Chat | Feedback | Customize | ASP/ VbScript Home | Site Home | Other Sites | About the Site | Feedback | Link to the Site | Awards | Advertising | Privacy

Copyright© 1997 by Exhedra Solutions, Inc. All Rights Reserved.  By using this site you agree to its Terms and Conditions.  Planet Source Code (tm) and the phrase "Dream It. Code It" (tm) are trademarks of Exhedra Solutions, Inc.