·您的位置: 首页 » 资源教程 » 编程开发 » ASP » HTML条形图函数库

HTML条形图函数库

类别: ASP教程  评论数:0 总得分:0
<%
Class BarChart

Private mchartBGcolor
Private mchartTitle
Private mchartWidth
Private mchartValueArray
Private mchartLabelsArray
Private mchartColorArray
Private mchartViewDataType
Private mchartBarHeight
Private mchartBorder
Private mchartTextColor
Private mchartCounter \' general counter
Private mchartMaxValue
Private mchartFactor
Private mchartTotalValues
Private mchartMinValue

Public Property LET chartBGcolor(strColor)
mchartBGcolor = strColor

\'code validation
IF LEN(mchartBGcolor) <> 7 THEN
ERR.Number = vbObjectError + 1000
ERR.Description = "Color string provided unequal to 7 characters"
Response.Write Err.Number & vbCRLF & ERR.Description
ERR.Clear

EXIT Property
END IF
END Property

Public Property LET chartTitle(strTitle)
mchartTitle = strTitle
END Property

Public Property LET chartWidth(intWidth)
mchartWidth = intWidth
END Property

Public Property LET chartValueArray(arrValues)

mchartValueArray = arrValues

IF NOT isArray(mchartValueArray) THEN
ERR.Number = vbObjectError + 1001
ERR.Description = "Values passed are not an array"
Response.Write Err.Number & vbCRLF & ERR.Description
EXIT Property
ERR.Clear
ERR.Number = vbObjectError + 1002
ERR.Description "Number of values passed does not match labels"
Response.Write Err.Number & vbCRLF & ERR.Description
ERR.Clear
EXIT Property
END IF

END Property

Public Property LET chartLabelsArray(arrLabels)

mchartLabelsArray = arrLabels

IF NOT isArray(mchartLabelsArray) THEN
ERR.Number = vbObjectError + 1001
ERR.Description = "Label values passed are not an array"
Response.Write Err.Number & vbCRLF & ERR.Description
EXIT Property
ERR.Clear
ELSEIF UBOUND(mchartValueArray) <> UBOUND(mchartLabelsArray) THEN
ERR.Number = vbObjectError + 1002
ERR.Description = "Number of values passed does not match labels"
Response.Write Err.Number & vbCRLF & ERR.Description
ERR.Clear
EXIT Property
END IF
END Property

Public Property LET chartColorArray(arrColors)
Dim tempNumOfColors, I

mchartColorArray = arrColors

IF NOT isArray(mchartColorArray) THEN
ERR.Number = vbObjectError + 1001
ERR.Description = "Color values passed are not an array"
Response.Write Err.Number & vbCRLF & ERR.Description
EXIT Property
ERR.Clear
END IF

\' match the number of the colors to the number of elements to draw
IF UBOUND(mchartColorArray) < UBOUND(mchartValueArray) THEN
tempNumOfColors = UBOUND(mchartColorArray) \'Get the number of colors provided

REDIM PRESERVE mchartColorArray(UBOUND(mchartValueArray))

\' Cycling the values through the array
For I = tempNumOfColors+1 to UBOUND(mchartColorArray)
mchartColorArray(I) = mchartColorArray((I mod (tempNumOfColors+1)))
NEXT

END IF
END Property

Public Property LET chartViewDataType(strProp)
mchartViewDataType = UCASE(strProp)

IF (mchartViewDataType <> "N") AND (mchartViewDataType <> "P") AND (mchartViewDataType <> "V")
THEN
mchartViewDataType = "V"
END IF

END Property

Public Property LET chartBarHeight(intBarHeight)
mchartBarHeight = intBarHeight

IF NOT ISNumeric(mchartBarHeight) THEN
ERR.Number = vbObjectError + 1003
ERR.Description "chartBarHeight property can only accept numerical values"
Response.Write Err.Number & vbCRLF & ERR.Description
EXIT Property
ERR.Clear
END IF
END Property

Public Property LET chartBorder(intBorder)
mchartBorder = intBorder

IF NOT ISNumeric(mchartBorder) THEN
ERR.Number = vbObjectError + 1003
ERR.Description "chartBorder property can only accept numerical values"
Response.Write Err.Number & vbCRLF & ERR.Description
EXIT Property
ERR.Clear
END IF
END Property

Public Property LET chartTextColor(strColor)
mchartTextColor = strColor

IF LEN(mchartTextColor) <> 7 THEN
ERR.Number = vbObjectError + 1000
ERR.Description = "Color string provided less than 7 characters"
Response.Write Err.Number & vbCRLF & ERR.Description
ERR.Clear
EXIT Property
END IF
END Property


Private Property LET chartMaxValue(intValue)
mchartMaxValue = intValue
END Property

Private Property LET chartMinValue(intValue)
mchartMinValue = intValue
END Property

Private Property LET chartTotalValues(intValue)
mchartTotalValues = intValue
END Property

Public Property GET chartMaxValue
chartMaxValue = mchartMaxValue
END Property

Public Property GET chartMinValue
chartMinValue = mchartMinValue
END Property

Public Property GET chartTotalValues
chartTotalValues = mchartTotalValues
END Property


Private Function MakeChart()
Dim F

\' getting the hieghest and lowest values within the array
\' and calculating the total of the values
mchartMinValue = 0
mchartMaxValue = 0
mchartTotalValues = 0
For each F in mchartValueArray
IF F > mchartMaxValue THEN
mchartMaxValue = F
END IF

IF mchartMinValue = 0 THEN
mchartMinValue = F
ELSEIF F < mchartMinValue THEN
mchartMinValue = F
\' Response.Write mchartMinValue
END IF

mchartTotalValues = mchartTotalValues + F
\' getting the total of the values in the array
NEXT

chartMaxValue = mchartMaxValue
chartMinValue = mchartMinValue
chartTotalValues = mchartTotalValues

\' Determining the factor to use for resizing the values to fit
\' within the given width
IF mchartMaxValue > (mchartWidth-20) THEN
\' getting the factor
mchartFactor = mchartMaxValue / (mchartWidth-20)
Response.Write("Factor of : " & mchartFactor & "<BR>")

\' changing the values of all the entries within the array
For mchartCounter = 0 to UBOUND(mchartValueArray)
mchartValueArray(mchartCounter) = CINT(mchartValueArray(mchartCounter) / mchartFactor)
NEXT
END IF

\' Modifying the chartLabelsArray to reflect the setting required
SELECT CASE mchartViewDataType
Case "V" \' display the value
For mchartCounter = 0 to UBOUND(mchartValueArray)
mchartLabelsArray(mchartCounter) = mchartLabelsArray(mchartCounter) & "-" &
mchartValueArray(mchartCounter)
NEXT

Case "P" \' display the percentage
For mchartCounter = 0 to UBOUND(mchartValueArray)
mchartLabelsArray(mchartCounter) = mchartLabelsArray(mchartCounter) & "-" &
((mchartValueArray(mchartCounter) / mchartTotalValues) * 100) & "%"
NEXT
END SELECT

MakeChart = "<table width=""" & mchartWidth & """ border=""" & mchartBorder & """>"
MakeChart = MakeChart & "<tr><td bgcolor=""" & mchartBGcolor & """>"

MakeChart = MakeChart & "<table width=""100%"" border=""0"" cellpadding=""1"" cellspacing=""1""><tr>"
MakeChart = MakeChart & "<th colspan=""2""><b><font face=""Arial, Tahoma, Verdana"" color=""" &
mchartTextColor & """ size=""1"">"
MakeChart = MakeChart & "<u><b>" & mchartTitle & "</b></u></font></th></tr>"

FOR mchartCounter = 0 to UBOUND(mchartValueArray)
MakeChart = MakeChart & "<tr><td valign=""middle"" align=""left"">"
MakeChart = MakeChart & "<font face=""Arial, Tahoma, Verdana"" color=""" & mchartTextColor & """
size=""1"">"
MakeChart = MakeChart & mchartLabelsArray(mchartCounter) & "</font></td>"
MakeChart = MakeChart & "<td valign=""middle"" align=""left"">"
MakeChart = MakeChart & "<table border=""0"" cellpadding=""1"" cellspacing=""0"">"
MakeChart = MakeChart & "<tr height=""" & mchartBarHeight & """>"
MakeChart = MakeChart & "<td width=""" & mchartValueArray(mchartCounter) & """ bgcolor=""" &
mchartColorArray(mchartCounter) & """>"
MakeChart = MakeChart & "<img src=""chart.gif"" width=""1"" height=""" & mchartBarHeight & """>"
MakeChart = MakeChart & "</td></tr></table>"
MakeChart = MakeChart & "</td></tr>"
NEXT

MakeChart = MakeChart & "</table>"
MakeChart = MakeChart & "</tr></td></table>"
MakeChart = MakeChart & vbCRLF & "<!--Chart created with BarChartClass by Anton Bawab ?2000-->"
END Function

Public SUB Draw()
CheckProps()
Response.Write MakeChart()
END SUB

Private Function CheckProps()

IF ISEMPTY(mchartBGcolor) THEN chartBGcolor = "#FFFFFF"

IF ISEMPTY(mchartColorArray) THEN chartColorArray = Array
("#990000" , "#009900" , "#000099")

IF ISEMPTY(mchartTitle) THEN chartTitle = "Chart Title"

IF ISEMPTY(mchartViewDataType) THEN chartViewDataType = "V"

IF ISEMPTY(mchartBarHeight) Then mchartBarHeight = 15

IF ISEMPTY(mchartBorder) THEN mchartBorder = 0

IF ISEMPTY(mchartTextColor) THEN mchartTextColor = "#000000"

END FUNCTION
END CLASS
%>
-= 资 源 教 程 =-
文 章 搜 索
关键词:
类型:
范围:
纯粹空间 softpure.com
Copyright © 2006-2008 暖阳制作 版权所有
QQ: 15242663 (拒绝闲聊)  Email: faisun@sina.com
 纯粹空间 - 韩国酷站|酷站欣赏|教程大全|资源下载|免费博客|美女壁纸|设计素材|技术论坛   Valid XHTML 1.0 Transitional
百度搜索 谷歌搜索 Alexa搜索 | 粤ICP备19116064号-1