Win98-style Dialog Header

Create a Windows 98-Style dialog box header. Ever wanted to recreate that cool gradient bar that starts at one color and ends up another-without images? Now You Can! Easily Modifed to include icons or any type of images. BONUS: The "CreateColorTable()" function used in the script creates a 216 color table without using images! This script is totally independant of any other files or images, simply cut, paste and modifiy at your own will.

Original Author: Julio Negron

Inputs

Inputs are controlled by the form and explained within the script.

Assumptions

Some colors will not display properly on 256 color environments. The script does not compensate for this variable, it will display any and all colors it needs to accomplish the effect.

Returns

The code returns a basic table with cells that are opened just wide enough so you can see the background color, optional text is inserted in the first cell. Easily modified to include icons or images.

Side Affects

This code can output many cells depending on what colors are chosen for the effect, it may slightly hinder web site performance.

API Declarations

This code may be used freely either privately or commercially. It may NOT be sold through any medium or market for profit. Please notify me of any positive modifications: jnegron@volt.com.

Code

<% if Request.Form > "" then dim debug if Request.Form("debugOn") = "on" then debug = CBool("true") '**************************************************************************** 'This function creates a specified number of nonbreaking spaces '**************************************************************************** Private Function nbsp(iNumber) mySpace = " " do until count = iNumber mySpace = mySpace & mySpace count = count + 1 loop nbsp = mySpace end function '**************************************************************************** 'This function converts a three digit number into a two digit hex number and 'ensures that the result is always a two digit hex number. '**************************************************************************** Private Function smartHex(strRGB) if debug then Response.write "

"
	Response.Write "

"	
end if
	if typeName(strRGB) = "Double" or Len(strRGB) = 3 then
		strRGB = hex(strRGB)
	end if
if debug then
	Response.Write "

"
End If
	if len(strRGB) = 1 then
		strRGB = 0 & strRGB
	end if
If debug Then
	Response.Write "

"
End If
	smartHex = strRGB
If debug Then
	Response.Write "

"
	Response.Write "

smartHex Function (begin):	" & strRGB & "	TYPE:	" & TypeName(strRGB) & "
strRGB after Hex Conversion:	" & strRGB & "	TYPE:	" & TypeName(strRGB) & "
strRGB after Conditional Statement:	" & strRGB & "	TYPE:	" & TypeName(strRGB) & "
smartHex Function (end):	" & smartHex & "	TYPE:	" & TypeName(smartHex) & "


"
End IF
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 debug Then
	Response.write ""
	Response.Write ""
End If
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
If debug Then
	Response.Write ""
End If
else
	intNumber = colorEnd
end if
Select Case Len(intNumber)
	case 1
	intNumber = "00" & intNumber
	case 2
	intNumber = "0" & intNumber
End Select
If debug Then
	Response.Write ""
	Response.Write "CheckNum Function(begin): " & intNumber & " TYPE: " & TypeName(intNumber) & "
CheckNum Function(After 'if...then'): " & intNumber & " TYPE: " & TypeName(intNumber) & "
CheckNum Function(end): " & intNumber & " TYPE: " & TypeName(intNumber) & "
"
End If
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 at the end. Optional
'text can be added for use as a header.
'****************************************************************************
Public Function StartColorArray(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
	If debug Then Response.Write "count: " & count & "
"
	intNum1a = Int("&H" & Left(strColor1,2))
	If debug Then Response.Write "intNum1a: " & intNum1a & nbsp(2)
	intNum1b = Int("&H" & Mid(strColor1,3,2))
	If debug Then Response.Write "intNum1b: " & intNum1b & nbsp(2)
	intNum1c = Int("&H" & Right(strColor1,2))
	If debug Then Response.Write "intNum1c: " & intNum1c & "
"
	intNum2a = Int("&H" & Left(strColor2,2))
	If debug Then Response.Write "intNum2a: " & intNum2a & nbsp(2)
	intNum2b = Int("&H" & Mid(strColor2,3,2))
	If debug Then Response.Write "intNum2b: " & intNum2b & nbsp(2)
	intNum2c = Int("&H" & Right(strColor2,2))
	If debug Then Response.Write "intNum2c: " & intNum2c & "
"
	color1A	 = intNum1a
	color1B	 = intNum1b
	color1C	 = intNum1c
	color2A	 = intNum2a
	color2B	 = intNum2b
	color2C	 = intNum2c
	
	iTextWidth = len(strText) * 12
if not debug then
	Response.Write "		if strText = "" then 
			Response.Write "height='" & iHeight & "' "
		else
			iHeight = iTextSize * 10 - 10
			Response.Write "height='" & iHeight & "' "
		end if
	Response.Write "width='" & iWidth & "'>" _
	       & ""
End If
Do until strColor = strColor2
	If debug Then Response.Write "Start Loop " & count + 1 & "
"
	count = count + 1
	If debug Then
		Response.Write "color2A: " & color2A & "  Type: " & TypeName(color2A) & "  "
		Response.Write "color2B: " & color2B & "  Type: " & TypeName(color2B) & "  "
		Response.Write "color2C: " & color2C & "  Type: " & TypeName(color2C) & "  "
	End If
	intNum1a = CheckNum(intNum1a,color1A,color2A)
	intNum1b = CheckNum(intNum1b,color1B,color2B)
	intNum1c = CheckNum(intNum1c,color1C,color2C)
	If debug Then
		Response.Write "intNum1a: " & intNum1a & nbsp(2)
		Response.Write "intNum1b: " & intNum1b & nbsp(2)
		Response.Write "intNum1c: " & intNum1c & "
"
	End If
	strColor = smartHex(intNum1a) & smartHex(intNum1b) & smartHex(intNum1c)

	intNum1a = int("&H" & intNum1a)
	intNum1b = int("&H" & intNum1b)
	intNum1c = int("&H" & intNum1c)

	If debug Then 
		Response.Write "strColor: " & strColor & "
"
	Else
		Response.Write ""
	End IF

	If len(strColor) > 6 Then
		Response.Write "Error: Hex Number has surpassed the 6 digit limit."
		exit Do
	else if len(strColor) < 6 Then
		Response.Write "Error: Hex Number is less than the 6 digits."
		exit Do
	End If
	End If
	If debug Then
		Response.Write "strColor1: " & strColor1 & "" & nbsp(4) _
				 & "strColor2: " & strColor2 & "" & "
"
		Response.Write "End Loop

"
	End If
loop
if not debug then
	if strText > "" then
		Response.Write ""
	end if
	Response.Write ""
		if strText > "" then
			 Response.Write "" _
	     & " " & strText & ""
		end if
	Response.Write " 		 
	
"
end if
end function
end if
'*************************************************************************
'This function creates a color table with 216 colors, no images needed. :0)
'NOTE: this function has only been tested in a 16 bit color display.
'*************************************************************************
Function CreateColorTable()
dim arColor(216)
arColor(0) = "00FF00"
arColor(1) = "00FF33"
arColor(2) = "00FF66"
arColor(3) = "00FF99"
arColor(4) = "00FFCC"
arColor(5) = "00FFFF"
arColor(6) = "33FF00"
arColor(7) = "33FF33"
arColor(8) = "33FF66"
arColor(9) = "33FF99"
arColor(10) = "33FFCC"
arColor(11) = "33FFFF"
arColor(12) = "66FF00"
arColor(13) = "66FF33"
arColor(14) = "66FF66"
arColor(15) = "66FF99"
arColor(16) = "66FFCC"
arColor(17) = "66FFFF"
arColor(18) = "99FF00"
arColor(19) = "99FF33"
arColor(20) = "99FF66"
arColor(21) = "99FF99"
arColor(22) = "99FFCC"
arColor(23) = "99FFFF"
arColor(24) = "CCFF00"
arColor(25) = "CCFF33"
arColor(26) = "CCFF66"
arColor(27) = "CCFF99"
arColor(28) = "CCFFCC"
arColor(29) = "CCFFFF"
arColor(30) = "FFFF00"
arColor(31) = "FFFF33"
arColor(32) = "FFFF66"
arColor(33) = "FFFF99"
arColor(34) = "FFFFCC"
arColor(35) = "FFFFFF"
arColor(36) = "00CC00"
arColor(37) = "00CC33"
arColor(38) = "00CC66"
arColor(39) = "00CC99"
arColor(40) = "00CCCC"
arColor(41) = "00CCFF"
arColor(42) = "33CC00"
arColor(43) = "33CC33"
arColor(44) = "33CC66"
arColor(45) = "33CC99"
arColor(46) = "33CCCC"
arColor(47) = "33CCFF"
arColor(48) = "66CC00"
arColor(49) = "66CC33"
arColor(50) = "66CC66"
arColor(51) = "66CC99"
arColor(52) = "66CCCC"
arColor(53) = "66CCFF"
arColor(54) = "99CC00"
arColor(55) = "99CC33"
arColor(56) = "99CC66"
arColor(57) = "99CC99"
arColor(58) = "99CCCC"
arColor(59) = "99CCFF"
arColor(60) = "CCCC00"
arColor(61) = "CCCC33"
arColor(62) = "CCCC66"
arColor(63) = "CCCC99"
arColor(64) = "CCCCCC"
arColor(65) = "CCCCFF"
arColor(66) = "FFCC00"
arColor(67) = "FFCC33"
arColor(68) = "FFCC66"
arColor(69) = "FFCC99"
arColor(70) = "FFCCCC"
arColor(71) = "FFCCFF"
arColor(72) = "009900"
arColor(73) = "009933"
arColor(74) = "009966"
arColor(75) = "009999"
arColor(76) = "0099CC"
arColor(77) = "0099FF"
arColor(78) = "339900"
arColor(79) = "339933"
arColor(80) = "339966"
arColor(81) = "339999"
arColor(82) = "3399CC"
arColor(83) = "3399FF"
arColor(84) = "669900"
arColor(85) = "669933"
arColor(86) = "669966"
arColor(87) = "669999"
arColor(88) = "6699CC"
arColor(89) = "6699FF"
arColor(90) = "999900"
arColor(91) = "999933"
arColor(92) = "999966"
arColor(93) = "999999"
arColor(94) = "9999CC"
arColor(95) = "9999FF"
arColor(96) = "CC9900"
arColor(97) = "CC9933"
arColor(98) = "CC9966"
arColor(99) = "CC9999"
arColor(100) = "CC99CC"
arColor(101) = "CC99FF"
arColor(102) = "FF9900"
arColor(103) = "FF9933"
arColor(104) = "FF9966"
arColor(105) = "FF9999"
arColor(106) = "FF99CC"
arColor(107) = "FF99FF"
arColor(108) = "006600"
arColor(109) = "006633"
arColor(110) = "006666"
arColor(111) = "006699"
arColor(112) = "0066CC"
arColor(113) = "0066FF"
arColor(114) = "336600"
arColor(115) = "336633"
arColor(116) = "336666"
arColor(117) = "336699"
arColor(118) = "3366CC"
arColor(119) = "3366FF"
arColor(120) = "666600"
arColor(121) = "666633"
arColor(122) = "666666"
arColor(123) = "666699"
arColor(124) = "6666CC"
arColor(125) = "6666FF"
arColor(126) = "996600"
arColor(127) = "996633"
arColor(128) = "996666"
arColor(129) = "996699"
arColor(130) = "9966CC"
arColor(131) = "9966FF"
arColor(132) = "CC6600"
arColor(133) = "CC6633"
arColor(134) = "CC6666"
arColor(135) = "CC6699"
arColor(136) = "CC66CC"
arColor(137) = "CC66FF"
arColor(138) = "FF6600"
arColor(139) = "FF6633"
arColor(140) = "FF6666"
arColor(141) = "FF6699"
arColor(142) = "FF66CC"
arColor(143) = "FF66FF"
arColor(144) = "003300"
arColor(145) = "003333"
arColor(146) = "003366"
arColor(147) = "003399"
arColor(148) = "0033CC"
arColor(149) = "0033FF"
arColor(150) = "333300"
arColor(151) = "333333"
arColor(152) = "333366"
arColor(153) = "333399"
arColor(154) = "3333CC"
arColor(155) = "3333FF"
arColor(156) = "663300"
arColor(157) = "663333"
arColor(158) = "663366"
arColor(159) = "663399"
arColor(160) = "6633CC"
arColor(161) = "6633FF"
arColor(162) = "993300"
arColor(163) = "993333"
arColor(164) = "993366"
arColor(165) = "993399"
arColor(166) = "9933CC"
arColor(167) = "9933FF"
arColor(168) = "CC3300"
arColor(169) = "CC3333"
arColor(170) = "CC3366"
arColor(171) = "CC3399"
arColor(172) = "CC33CC"
arColor(173) = "CC33FF"
arColor(174) = "FF3300"
arColor(175) = "FF3333"
arColor(176) = "FF3366"
arColor(177) = "FF3399"
arColor(178) = "FF33CC"
arColor(179) = "FF33FF"
arColor(180) = "000000"
arColor(181) = "000033"
arColor(182) = "000066"
arColor(183) = "000099"
arColor(184) = "0000CC"
arColor(185) = "0000FF"
arColor(186) = "330000"
arColor(187) = "330033"
arColor(188) = "330066"
arColor(189) = "330099"
arColor(190) = "3300CC"
arColor(191) = "3300FF"
arColor(192) = "660000"
arColor(193) = "660033"
arColor(194) = "660066"
arColor(195) = "660099"
arColor(196) = "6600CC"
arColor(197) = "6600FF"
arColor(198) = "990000"
arColor(199) = "990033"
arColor(200) = "990066"
arColor(201) = "990099"
arColor(202) = "9900CC"
arColor(203) = "9900FF"
arColor(204) = "CC0000"
arColor(205) = "CC0033"
arColor(206) = "CC0066"
arColor(207) = "CC0099"
arColor(208) = "CC00CC"
arColor(209) = "CC00FF"
arColor(210) = "FF0000"
arColor(211) = "FF0033"
arColor(212) = "FF0066"
arColor(213) = "FF0099"
arColor(214) = "FF00CC"
arColor(215) = "FF00FF"
Response.Write ""
count = 0
Do Until count = 216
	Response.Write ""
	count = count + 1
	select case count
		Case 36
			Response.Write ""
		Case 72
			Response.Write ""
		Case 108
			Response.Write ""
		Case 144
			Response.Write ""
		Case 180
			Response.Write ""
		Case 216
			Response.Write "" _
				 & "				 & "onMouseOver=javascript:showColorView('" & arColor(count) & "')>" _
				 & "   
"
	End Select
Loop
End Function
%>

Gradient Bar Function <% if debug then response.write "- DEBUG Mode" %>














			
			<%= CreateColorTable() %>
		 	
			
			
		 		
			
		 	

Click on a cell to set color for selected item.













	">

	Start Color:
	
	">

	

	End Color: 

	">

	Height: "> 
	Width: "> 










Enable Text 
	
	Text Color: 
	">
	

>Debug

	Text: "> 
	Text Size(1-9): ">




<%
if Request.Form > "" then
myColor1 = UCase(Request.Form("frmColor1"))
myColor2 = UCase(Request.Form("frmColor2"))
myHeight = Request.Form("frmHeight")
myWidth = Request.Form("frmWidth")
myText = Request.Form("frmText")
myTextColor = Request.Form("frmTextColor")
myTextSize = Request.Form("frmTextSize")
Response.Write "Output"
if debug then Response.Write " - Debug Mode"
Response.Write ":
"
Response.Write StartColorArray(myColor1,myColor2,myHeight,myWidth,myText,myTextColor,myTextSize)
set myColor1 = nothing
set myColor2 = nothing
set myHeight = nothing
set myWidth = nothing
set myText = nothing
set myTextColor = nothing
set myTextSize = nothing
end if
%>

About this post

Posted: 2002-06-01
By: ArchiveBot
Viewed: 76 times

Comments

No comments have been added for this post.

You must be logged in to make a comment.

CheckNum Function(begin):	" & intNumber & "	TYPE:	" & TypeName(intNumber) & "
CheckNum Function(After 'if...then'):	" & intNumber & "	TYPE:	" & TypeName(intNumber) & "
CheckNum Function(end):	" & intNumber & "	TYPE:	" & TypeName(intNumber) & "