<% '这段注释不影响性能和速度,请保留 '开发人:宋新成 '形式:开源 '官方网址:www.idesktop.com.cn '使用范围:各种需要生成图形报表,而又不能安装插件或者对速度要求比较高的系统 '联系方式:sxch2003@gmail.com 或 sxch2003@163.com '演示地址:www.idesktop.com.cn/demo.htm '立体图形产生模块需要付费,50RMB,一年内升级免费 Class AspVml dim lcolor Private Sub Class_Initialize lcolor="blue" End Sub ' Destructor''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Sub Class_Terminate End Sub function setColor(color) lcolor=color end function Function CreatePic(w,h,dc,t) Dim header,tail Dim content Dim linex,liney Dim back,lback Dim piestr Dim num Dim width DIm height num=dc.count width=getWidth(num) height=getHeight(num) 'height=500 header=GetHeader(width,height,t) tail=GetTail() piestr="" linex=DrawLineX(dc.count,width,height) liney=DrawLineY(width,height) back=GetBackground(width,height) lback=GetLegendBack(width,height) if(t=1) then content=GetContent(dc,width,height) elseif (t=2) then content=CreateLine(dc,width,height) elseif (t=3) then piestr=wirtePieHeader linex="" liney="" header=GetPieHeader(width,height,t) content=createPie(dc,width,height) else content=GetContent(dc) end if CreatePic=piestr & header&back&lback&content&linex&liney&tail End Function function getWidth(num) dim ret if(num>20) then ret=int(num*700/20)+1 else ret=700 end if getWidth=ret end function function getHeight(num) dim ret if(num>20) then ret=int(num*500/20)+1 else ret=500 end if getHeight=ret end function Function GetHeader(w,h,t) Dim panel_header Dim bw,bh bw=int(w/700*5900)+1 bh=int(h/500*2900)+1 Dim x1,y1 Dim xs2,ys2,xe2,ye2 Dim xs3,ys3,xe3,ye3 x1=int(w/700*4900)+1 y1=int(h/500*3500)+1 xs2=200 ys2=100 xe2=200 ye2=int(h/500*2700)+1 xs3=200 ys3=2700 xe3=int(w/700*4500)+1 ye3=2700 panel_header="<v:group ID=""col"&t&""" style=""WIDTH:"&w&"px;HEIGHT:"&h&"px"" coordsize="""&x1&","&y1&" ""><v:line from=""200,100"" to=""200,"&ye2&""" style=""Z-INDEX:8;POSITION:absolute"" strokeweight=""1pt""><v:stroke StartArrow=""classic""/></v:line><v:line from=""200,"&ye2&""" to="""&xe3&","&ye2&""" style=""Z-INDEX:8;POSITION:absolute"" strokeweight=""1pt""><v:stroke EndArrow=""classic""/></v:line><v:rect style=""WIDTH:"&bw&"px;HEIGHT:"&bh&"px"" coordsize=""21600,21600"" fillcolor=""#EEEEEE"" ><v:shadow on=""t"" type=""single"" color=""silver"" offset=""4pt,3pt""></v:shadow></v:rect>" GetHeader=panel_header End Function Function GetPieHeader(w,h,t) Dim panel_header Dim x1,y1 Dim bw,bh bw=int(w/700*5900)+1 bh=int(h/500*2900)+1 x1=int(w/700*4900)+1 y1=int(h/500*3500)+1 panel_header="<v:group ID=""col"&t&""" style=""WIDTH:"&w&"px;HEIGHT:"&h&"px"" coordsize="""&x1&","&y1&"""><v:rect style=""WIDTH:"&bw&"px;HEIGHT:"&bh&"px"" coordsize=""21600,21600"" fillcolor=""#EEEEEE"" ><v:shadow on=""t"" type=""single"" color=""silver"" offset=""4pt,3pt""></v:shadow></v:rect>" GetPieHeader=panel_header End Function Function GetBackground(w,h) dim str Dim bw,bh bw=int(w/700*4300)+1 bh=int(h/500*2700)+1 str=" <v:rect id='back' style='position:relative;left:200;top:150;width:"&bw&"; height:"&bh&";' fillcolor='#9cf' strokecolor='#DFDFDF'> <v:fill rotate='t' angle='-45' focus='100%' type='gradient'/></v:rect> " GetBackground=str End Function Function GetLegendBack(w,h) dim str Dim bw,bh dim leftw 'bw=int(w/700*5900)+1 bh=int(h/500*2550)+1 leftw=int(w/700*4700)+1 str=" <v:rect id='back2' style='position:relative;left:"&leftw&";top:150;width:1000; height:"&bh&";' fillcolor='#9cf' stroked='t' strokecolor='#0099ff'><v:fill rotate='t' angle='-175' focus='100%' type='gradient'/> <v:shadow on='t' type='single' color='silver' offset='3pt,3pt'/></v:rect>" GetLegendBack=str End Function Function DrawLineX(num,w,h) dim i,str,left_pad dim width,ye2 ye2=int(h/500*2700)+1 width=200 for i=0 to num left_pad=(i*width)+210 str=str&"<v:line from='"&left_pad&""&ye2&"' to='"&left_pad&""&(ye2+50)&"' style='position:relative;z-index:8'></v:line>" next DrawLineX=str End function Function DrawLineY(w,h) dim i,str,left_pad,max Dim retmain,increment max=GetMaxValue(dc) Dim x1,x2 dim y1,y2 Dim spa,spa2,xspos x1=int(w/700*4300)+1 y1=int(h/500*2600)+1 spa=int(y1/5)+1 spa2=int(spa/2) xspos=int(y1/2600*200)+1 increment=max/5 for i=1 to 5 left_pad=y1-((i)*spa)+xspos str=str&"<v:line from='200 "&left_pad&"' to='"&x1&""&left_pad&"' style='position:relative;z-index:8' strokeweight='1pt'><v:stroke color='#0099FF' /></v:line>" str=str&"<v:line from='200 "&(left_pad+spa2)&"' to='"&x1&""&(left_pad+spa2)&"' style='position:relative;z-index:8' color='#0099FF'><v:stroke dashstyle='Dot'/></v:line>" str=str&"<v:Rect style=""left:-50;top:"&(left_pad-100)&";width:10;height:100"" filled=""f"" stroked=""f""> <v:TextBox inset=""10pt,10pt,10pt,10pt"" style=""font-size:9pt;""><div align=""left"">"&(i*increment)&"</div></v:TextBox></v:Rect>" next DrawLineY=str End function Function GetTail() GetTail="</group>" end Function Function GetMaxValue(dc) dim keys,val,max dim valarr,i,retmain max=0 valarr=dc.items() for i=0 to ubound(valarr) if(valarr(i)>max) then max=valarr(i) end if next retmain=max mod 5 if(retmain<>0) then retmain=5-retmain max=max+retmain end if GetMaxValue=max end Function Function GetContent(dc,w,h) dim num,str,keys,width,height Dim heightx,widthx dim max,val,i,left_pad,top Dim lenheight dim topspa,y1 max=GetMaxValue(dc) num=dc.count width=200 lenheight=120 heightx=int(h/500*2500)+1 widthx=int(w/700*4700)+80 topspa=int(h/500*200)+1 'y1=int(h/500*2500)+1 i=0 for each keys in dc left_pad=(i*width)+210 val=dc(keys) height=(val*heightx)/max top=heightx-height+topspa 'str=str&"<v:rect style=""left:470;top:1280;WIDTH:100px;HEIGHT:1420px"" fillcolor=""blue""></v:rect>" str=str&"<v:rect style='position:relative;left:"&left_pad&";top:"& (top) &";WIDTH:"&(width*1/2)&"px;HEIGHT:"& height &";z-index:9' coordsize='21600,21600' fillcolor='"& lcolor &"'></v:rect>" str=str&"<v:Rect style=""left:"&(left_pad-100)&";top:"& (heightx+topspa) &";width:1000;height:100;position:relative;"" filled=""f"" stroked=""f""> <v:TextBox inset=""10pt,10pt,10pt,10pt"" style=""font-size:9pt;""><div align=""left"">"&(i+1)&"</div></v:TextBox></v:Rect>"