IDC资讯中心
<%
###################################################
## barchart #
## class to draw bar charts in asp applications #
## author : anton bawab #
## first written : march 27th 2000 #
###################################################
###################################################
## include this file in your asp script #
## assign the properties #
## then use the draw method #
###################################################
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
%>
