Self-Generating Color Cubes

Category:

ASP, HTML and XML

Type:

Applications

Difficulty:

Intermediate

Author: Yasar Bayar

Version Compatibility: ASP

More information:

This small code is written for those webmasters having trouble to choose colors to be used in their websites. It quickly generates a set of RGB colors and their corresponding color codes so you can see what each looks like.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
' (None)

Code:

<%@LANGUAGE="VBSCRIPT" CODEPAGE="1254"%>
<HTML>
<HEAD>

<BODY bgcolor="#000000" text="#FFFFFF">
<%
if not request("generate")<>"" then
%>
<TABLE width="50%" align="center" cellpadding="0" cellspacing="0" border="0">
  <FORM method="get">
  <TR>
    <TD width="80%">1 - Number of row in cube</td>
    <TD width="20%"><INPUT name="row" type="text" id="row" value="10" size="5"></td>
  </tr>
  <TR>
    <TD>2 - Number of column in cube</td>
    <TD><INPUT name="col" type="text" id="col" value="4" size="5"></td>
  </tr>
  <TR>
    <TD>3 - Number of color in one group</td>
    <TD><INPUT name="group" type="text" id="group" value="4" size="5"></td>
  </tr>
  <TR>
    <TD>4 - The lowest color code</td>
    <TD><INPUT name="low" type="text" id="low" value="200" size="5"></td>
  </tr>
  <TR>
    <TD>5 - The highest color code</td>
    <TD><INPUT name="high" type="text" id="high" value="255" size="5"></td>
  </tr>
  <TR>
    <TD>6 - The diversion factor</td>
    <TD><INPUT name="factor" type="text" id="factor" value="0,8" size="5"></td>
  </tr>
  <TR align="center">
    <TD colspan="2"><BR>
      <OL><LI>The color codes range from 0-255. The exceeding numbers
          will be rounded to 255.</li>
      <LI>The diversion factor is used for generating various colors in a group.
        Values closer to 1 will cause in small changes, however values diverging
        from 1 will cause in greater changes. You can use floating numbers.</li>
      <LI>The values in parameter 1-2-3 will effect the number of color groups
        generated.</li>
      </ol>      
      <P>Each time you refresh the page with same parameters, you get different
        color groups. This script uses randomize function.</p>
      <P>CeZR | <A href="mailto:ybayar@commion.com">ybayar@commion.com</a></p>
      <P>
        <INPUT type="submit" name="Generate" value="Generate !">
      </p></td>
  </tr>
  </form>
</table>
<%
else
	if request("Low")<>"" then 
		rangeLow=request("Low")
	else
		rangeLow=200
	end if
	
	if request("High")<>"" then 
		rangeHigh=request("High")
	else
		rangeHigh=255
	end if
	
	if request("row")<>"" then 
		cubeRow=request("row")
	else
		cubeRow=10
	end if
	
	if request("Col")<>"" then 
		cubeCol=request("Col")
	else
		cubeCol=3
	end if
	
	if request("factor")<>"" then 
		factor=request("factor")
	else
		factor=0.8
	end if
	
	if request("group")<>"" then 
		group=request("group")
	else
		group=4
	end if
%>
<TABLE align="center">
<%for row=1 to cubeRow%>
  <TR>
	<%for col=1 to cubeCol%>
		<TD>
		<%
		response.Flush()
		response.write putCodes(cTop,cMiddle,cBottom) & "<hr>"
		%>
		</td>
	<%next%>
  </tr>
<%next%>
</table>
<%end if%>
</body>
</html>
<%
function putCodes(cTop,cMiddle,cBottom)
	s=s & "<TABLE width=""150"" border=""0"" cellpadding=""0"" cellspacing=""0"">"
	cTop=getRandomColor()
	s=s & "<TR><TD width=""150"" height=""20"" bgcolor=""#" & cTop & """><font color=""" & neg2(cTop) & """>" & cTop & "</font></td></tr>"
	cMiddle=cTop
	for k=1 to group-1
		cMiddle=getMatchingColor(cMiddle)
		s=s & "<TR><TD height=""20"" bgcolor=""#" & cMiddle & """><font color=""" & neg2(cMiddle) & """>" & cMiddle & "</font></td></tr>"
	next
	s=s & "</table>"
	putCodes=s
end function

function getRandomNumber(low,high)
	getRandomNumber=Int(((high-low) * Rnd) + low)
end function

function getRandomColor()
	Randomize
	sR=fixColorCode(Hex(getRandomNumber(rangeLow,rangeHigh)))
	sG=fixColorCode(Hex(getRandomNumber(rangeLow,rangeHigh)))
	sB=fixColorCode(Hex(getRandomNumber(rangeLow,rangeHigh)))
	getRandomColor=sR & sG & sB
end function

function getMatchingColor(sColor)
	sR=left(sColor,2)
	sG=mid(sColor,3,2)
	sB=right(sColor,2)
	iR=int(convertHexToDec(sR)*factor) mod 256
	iG=int(convertHexToDec(sG)*factor) mod 256
	iB=int(convertHexToDec(sB)*factor) mod 256
	sR=fixColorCode(hex(iR))
	sG=fixColorCode(hex(iG))
	sB=fixColorCode(hex(iB))
	sColor2=sR & sG & sB
	getMatchingColor=sColor2
end function

function neg2(sColor)
	topHex="FF"
	topInt=convertHexToDec(topHex)
	sR=left(sColor,2)
	sG=mid(sColor,3,2)
	sB=right(sColor,2)
	nR=Hex(topInt-convertHexToDec(sR))
	nG=Hex(topInt-convertHexToDec(sG))
	nB=Hex(topInt-convertHexToDec(sB))
	negColor=nR & nG & nB
	neg2=negColor
end function

function convertHexToDec(hNumber)
	out=0
	for i=1 to len(hNumber)
		out=out + getIntFromHex(mid(hNumber,len(hNumber)-i+1,1)) * (16^(i-1))
	next
	convertHexToDec=out
end function

function getIntFromHex(h)
	select case h
		case "0","1","2","3","4","5","6","7","8","9": out=cInt(h)
		case "A": out=10
		case "B": out=11
		case "C": out=12
		case "D": out=13
		case "E": out=14
		case "F": out=15
	end select
	getIntFromHex=out
end function

function fixColorCode(s)
	if len(s)<2 then 
		out="0" & s
	else
		out=s
	end if
	fixColorCode=out
end function
%>