programming-examples/asp/Miscellaneous/Gradient Banner.asp
2019-11-18 14:25:58 +01:00

141 lines
4.5 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

<%
'The first three functions are used in the viewGradient() function. This code is largely undocumented but I will be working on that for a future upgrade of the code.
'This function creates a specified number of nonbreaking spaces
Private Function nbsp(iNumber)
dim mySpace
do until count = iNumber
mySpace = mySpace & " "
count = count + 1
loop
nbsp = mySpace
set mySpace = nothing
end function
'********
'This function converts a three digit number into a two digit hex number.
Private Function smartHex(strRGB)
if typeName(strRGB) = "Double" or Len(strRGB) = 3 then
strRGB = hex(strRGB)
end if
if len(strRGB) = 1 then
strRGB = 0 & strRGB
end if
smartHex = strRGB
End function
'******
'This function takes a three digit integer and increments it
'or decreases it by 1 depending on the colorEnd variable. If the
'colorEnd and the colorStart variables are equal, it will not change
'the resulting number.
Private Function CheckNum(intNumber,colorStart,colorEnd)
if intNumber <> colorEnd then
if colorEnd > colorStart then
if intNumber = "255" then
intNumber = intNumber
else
intNumber = intNumber + 1
end if
else if colorEnd < colorStart then
if intNumber = "0" then
intNumber = intNumber
else
intNumber = intNumber - 1
end if
else if colorEnd = colorStart then
intNumber = intNumber
end if
end if
end if
else
intNumber = colorEnd
end if
Select Case Len(intNumber)
case 1
intNumber = "00" & intNumber
case 2
intNumber = "0" & intNumber
End Select
CheckNum = intNumber
end function
'******
'This function creates a banner with a specified height and width who's
'background color starts as one color and ends up as another. Optional
'text can be added for use as a header.
Public Function viewGradient(strColor1,strColor2,iHeight,iWidth,strText,strTextColor,iTextSize)
dim strColor, count
dim intNum1a, intNum1b, intNum1c, intNum2a, intNum2b, intNum2c
dim color1a, color1b, color1c, color2a, color2b, color2c
count = 0
intNum1a = Int("&H" & Left(strColor1,2))
intNum1b = Int("&H" & Mid(strColor1,3,2))
intNum1c = Int("&H" & Right(strColor1,2))
intNum2a = Int("&H" & Left(strColor2,2))
intNum2b = Int("&H" & Mid(strColor2,3,2))
intNum2c = Int("&H" & Right(strColor2,2))
color1A = intNum1a
color1B = intNum1b
color1C = intNum1c
color2A = intNum2a
color2B = intNum2b
color2C = intNum2c
iTextWidth = len(strText) * 10
'iTextWidth = 100
Response.Write "<table BORDER='0' CELLSPACING='0' CELLPADDING='0' "
if strText = "" then
'if iHeight = "undefined" then iHeight = 30
Response.Write "height='" & iHeight & "' "
else
iHeight = iTextSize * 10 - 10
Response.Write "height='" & iHeight & "' "
end if
'Response.Write "width='" & iWidth & "'" _
Response.Write "><tr>" _
& "<td bgColor='#" & strColor1 & "' width='" & iTextWidth & "'>"
if strText > "" then
Response.Write "<font color='" & strTextColor & "' size='" & iTextSize & "'>" _
& " <STRONG>" & strText & "</STRONG></font>"
end if
Response.Write "</td>"
Do until strColor = strColor2
count = count + 1
intNum1a = CheckNum(intNum1a,color1A,color2A)'<-------necessary
intNum1b = CheckNum(intNum1b,color1B,color2B)'<-------necessary
intNum1c = CheckNum(intNum1c,color1C,color2C)'<-------necessary
strColor = smartHex(intNum1a) & smartHex(intNum1b) & smartHex(intNum1c)
intNum1a = int("&H" & intNum1a)
intNum1b = int("&H" & intNum1b)
intNum1c = int("&H" & intNum1c)
Response.Write "<td width='5' bgcolor='#" & strColor & "'>" _
& "<br>" _
& "</td>"
If len(strColor) > 6 Then
Response.Write "<font color=red size=+1><b>Error:</b> Hex Number has <b>surpassed</b> the 6 digit limit.</font>"
exit Do
else if len(strColor) < 6 Then
Response.Write "<font color=red size=+1><b>Error:</b> Hex Number is <b>less</b> than the 6 digits.</font>"
exit Do
End If
End If
loop
if strText > "" then
Response.Write "<td width='10%' bgcolor='#" & strColor & "'><br></td>"
end if
Response.Write "</tr></table>"
end function
%>