clase para graficos de pastel buenisimo gracias... espero les sirva a todos tambien.
Código:
<%
class DrawPieGraph
private pvDiameter
private pvShadow
private pvTitle
private rsPieGraphValues
private pvShowLegend
private pvLegendSize
private pvHTMLinnerTableDef
private pvHTMLouterTableDef
private pvShowValues
private pvFormatValuesAsCurrency
private pvFontDef
'-----------
private function ReturnRecordset
dim rs
set rs = CreateObject("ADODB.Recordset")
'value fld is currency data type (6)
rs.Fields.append "value",6
'label fld is varchar type (200), length is 50 chars long max
rs.Fields.append "label",200,50
'color fld is varchar type (200), length is 20 chars long, must be hex value
rs.Fields.append "color",200,20
'open the rs ready for adding records
rs.Open
set ReturnRecordset = rs
end function
'----------
private function ReturnValueWithFontTags(value)
ReturnValueWithFontTags = pvFontDef & value & "</font>"
end function
'----------
private sub Class_Initialize
set rsPieGraphValues = ReturnRecordset
pvDiameter = 100
pvShadow = true
pvTitle = ""
pvShowLegend = true
pvLegendSize = 20
pvHTMLinnertableDef = "<table cols=""2"" border=1>"
pvHTMLouterTableDef = "<table cellpadding=""12"" style=""border: 2px outset;"">"
pvShowValues = true
pvFormatValuesAsCurrency = false
pvFontDef = "<font size=2>"
end sub
'----
'the diameter of the circle, integer
public property let Diameter(value)
pvDiameter=cint(value)
end property
'------------
public property get Diameter
Diameter=pvDiameter
end property
'------------
'the shadow true/false
public property let Shadow(value)
pvShadow=cbool(value)
end property
'-----------
public property get Shadow
Shadow=pvShadow
end property
'------------
'the title - string value
public property let Title(value)
pvTitle=cstr(value)
end property
'---------------
public property get Title
Title=pvTitle
end property
'------------
'draw out the legend
public property let ShowLegend(value)
pvShowLegend=cbool(value)
end property
'-----------
public property get ShowLegend
ShowLegend=pvShowLegend
end property
'---------
'the legend size
public property let LegendSize(value)
pvLegendSize=cstr(value)
end property
'----------
public property get LegendSize
LegendSize=pvLegendSize
end property
'---------
'table definition for inner table to allow customisation
public property let HTMLinnerTableDef(value)
pvHTMLinnertableDef=cstr(value)
end property
'----------
public property get HTMLinnerTableDef
HTMLinnerTableDef=pvHTMLinnertableDef
end property
'--------
'table definition for inner table to allow customisation
public property let HTMLouterTableDef(value)
pvHTMLouterTableDef=cstr(value)
end property
'----------
public property get HTMLouterTableDef
HTMLouterTableDef=pvHTMLouterTableDef
end property
'-----------
'show the values or not
public property let ShowValues(value)
pvShowValues=cbool(value)
end property
'--------------
public property get ShowValues
ShowValues=pvShowValues
end property
'-----------
'the size of the font for the value display
public property let FontDef(value)
pvFontDef=cstr(value)
end property
'-----------
public property get FontDef
FontDef=pvFontDef
end property
'------------
'format the values as currency or not
public property let FormatValuesAsCurrency(value)
pvFormatValuesAsCurrency=cbool(value)
end property
'-------
public property get FormatValuesAsCurrency
FormatValuesAsCurrency=pvFormatValuesAsCurrency
end property
'----------
'add the values for the different segments of the pie chart
public sub AddValue(value,label,color)
with rsPieGraphValues
.AddNew
.Fields("value") = value
.Fields("label") = label
.Fields("color") = color
.Update
end with
end sub
'--------------
public sub DeleteAllAddedValues
set rsPieGraphValues = nothing
set rsPieGraphValues = ReturnRecordset
end sub
'-------------
'draw the actual graph
public sub Draw
Dim startPoint, endPoint, sumOfValues, percentage, i
Dim strTitle, magicNumber
dim Height, Width
if rsPieGraphValues.EOF and rsPieGraphValues.BOF then exit sub
magicNumber = 23592960 ' It's mystical, magical, kinda nutty even
startPoint = 5850000 ' this setting is approximately 12:00 noon
strTitle=pvTitle
'height to width ratio is h:w = 0.75:1
'we work out the height and width from the diameter given
'the formula is diameter=100 therefore height=375pt; width=500pt
Height = round(pvDiameter * 3.75,0)
Width = round(pvDiameter * 5,0)
with response
' GET SUM OF VALUES ***
rsPieGraphValues.MoveFirst
do while not rsPieGraphValues.EOF
sumOfValues = sumOfValues + rsPieGraphValues("value").Value
rsPieGraphValues.MoveNext
loop
if sumOfValues=0 then exit sub
' VML tags *****
.Write "<xml:namespace prefix=""v""/>"
.Write "<object id=""VMLRender"" classid=""CLSID:10072CEC-8CC1-11D1-986E-00A0C955B42E"" width=""0"" height=""0""></object>"
.Write "<style> v\:* {behavior=url(#VMLRender)}</style>"
' *********
' Start Outer Table //
.Write pvHTMLouterTableDef & vbCrLf
.Write "<tr>" & vbCrLf
.Write "<td>" & vbCrLf
' ********
' Start Inner Table //
.Write pvHTMLinnertableDef & vbCrLf
if pvTitle<>"" then
.Write "<tr align=""center"" >" & vbCrLf
' Create Title //
if pvShowLegend then
.Write "<td colspan=""2""><b>" & strTitle & "</b><br><br></td>" & vbCrLf
else
.Write "<td><b>" & strTitle & "</b><br><br></td>" & vbCrLf
end if
.Write "</tr>" & vbCrLf
end if
' *** Start Building Pie //
.Write "<tr>" & vbCrLf
.Write "<td>" & vbCrLf
'VML tags
.Write "<div style=""margin-top=0pt"">" & vbCrLf
.Write "<v:group style=""height=" & Height & "pt; width=" & Width & "pt"" coordsize=""4320,3240"">" & vbCrLf
' BUILD THE SHADOW
if pvShadow then
.Write("<v:shape style='position:relative; width:4320; height:3240' fillcolor=#C0C0C0 path=""M 790 760 AE 790 760 707 707 " & startPoint & " " & magicNumber & " X E"">" & vbCrLf)
.Write("<v:stroke on=""False""/>" & vbCrLf)
.Write("</v:shape>" & vbCrLf)
end if
' BUILD THE PIE
rsPieGraphValues.MoveFirst
do while not rsPieGraphValues.EOF
percentage = FormatNumber(rsPieGraphValues("value").Value / sumOfValues, 3)
endPoint = magicNumber * percentage
endPoint = FormatNumber(endPoint, 0)
endPoint = Fix(endPoint)
.Write("<v:shape style='width:4320; height:3240' strokeweight=0.5pt fillcolor=" & rsPieGraphValues("color").Value & " path=""M 750 720 AE 750 720 707 707 " & startPoint & " " & endPoint & " X E""/>" & vbCrLf)
startPoint = startPoint + endPoint
rsPieGraphValues.MoveNext
loop
' VML tag
.Write("</v:group></div>" & vbCrLf)
.Write("</td>" & vbCrLf)
' End Build Pie
' Start Legend Table
if pvShowLegend then
.Write("<td>" & vbCrLf)
.Write("<table bordercolor=""white"" border=""1"" cellpadding=""2"">" & vbCrLf)
' Step 6) BUILD THE LEGEND
rsPieGraphValues.MoveFirst
do while not rsPieGraphValues.EOF
.Write("<tr>" & vbCrLf)
' Color //
.Write "<td><img src='../images/1pixel.gif' border=1 width='" & pvLegendSize & "' height='" & pvLegendSize & "' style='background:" & rsPieGraphValues("color").Value & ";'/></td>"
' Category //
.Write("<td width=""75"">" & vbCrLf)
.Write ReturnValueWithFontTags(rsPieGraphValues("label").Value) & vbCrLf
.Write("</td>" & vbCrLf)
' Value or Percent //
if pvShowValues then
.Write("<td align=""right"">" & vbCrLf)
if pvFormatValuesAsCurrency then
.Write ReturnValueWithFontTags(formatnumber(rsPieGraphValues("value").Value,2,true,false,false)) & vbCrLf
else
.Write ReturnValueWithFontTags(rsPieGraphValues("value").Value) & vbCrLf
end if
.Write("</td>" & vbCrLf)
end if
.Write("</tr>" & vbCrLf)
rsPieGraphValues.MoveNext
loop
' End Legend Table
.Write("</table>" & vbCrLf)
.Write("</td>" & vbCrLf)
end if
' End Inner Table
.Write("</tr>" & vbCrLf)
.Write("</table>" & vbCrLf)
' End Outer Table
.Write("</td>" & vbCrLf)
.Write("</tr>" & vbCrlf)
.Write("</table>" & vbCrLf)
end with
end sub
end class
%>
