 |
|
|
 首页 |
名片设计 CorelDRAW Illustrator AuotoCAD Painter 其他软件 Photoshop Fireworks Flash |
|
<% 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 %> 返回类别: 教程 上一教程: 一个在VBSCRIPT中读取COOKIE的程序函数 下一教程: 一个免费的邮件列表源程序(一) 您可以阅读与"HTML条形图函数库"相关的教程: · 用正则表达式写的HTML分离函数 · ASP文件上传函数库 · 好东西，老外用正则表达式写的HTML分离函数 · ASP实用函数库 · HTML代码过滤函数 |
  |
| 快精灵印艺坊 版权所有 |
首页 会员中心在线印刷在线编辑付款方式索取样品设计指南连锁门店
|
||
