Win98-style Dialog Header
Posted: 2002-06-01
By: ArchiveBot
Viewed: 62
Filed Under:
No attachments for this post
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 "smartHex Function (begin): " & strRGB & " TYPE: " & TypeName(strRGB) & "
end if
if typeName(strRGB) = "Double" or Len(strRGB) = 3 then
strRGB = hex(strRGB)
end if
if debug then
Response.Write "strRGB after Hex Conversion: " & strRGB & " TYPE: " & TypeName(strRGB) & "
End If
if len(strRGB) = 1 then
strRGB = 0 & strRGB
end if
If debug Then
Response.Write "strRGB after Conditional Statement: " & strRGB & " TYPE: " & TypeName(strRGB) & " "
End If
smartHex = strRGB
If debug Then
Response.Write "smartHex Function (end): " & smartHex & " TYPE: " & TypeName(smartHex) & "
Response.Write "
"
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 "CheckNum Function(begin): " & intNumber & " TYPE: " & TypeName(intNumber) & "
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 "CheckNum Function(After 'if...then'): " & intNumber & " TYPE: " & TypeName(intNumber) & "
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 "CheckNum Function(end): " & intNumber & " TYPE: " & TypeName(intNumber) & "
Response.Write "
"
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 & "'>" _ "
& "" "
if strText > "" then
Response.Write "" _
& " " & strText & ""
end if
Response.Write "
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 "
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 "
End Select
Loop
End Function
%>
<%
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
%>
Comments on this post
No comments have been added for this post.
You must be logged in to make a comment.