共享一个ASP无组件折线图源码！强

我又来了，这几天我无意发现了一个地方有这个源码。当时下下来就没再找到那个网站。真得怪。好像是站长论坛上吧。这个效果不错。见图。

浏览页：http://www.szrgb.net/text/aspvml/ceshi.asp?ty=1&solid=true

只是现在只支持IE。

源码在下。相在代码：

 

<%
'这段注释不影响性能和速度，请保留
'开发人：宋新成
'形式：开源
'官方网址：www.idesktop.com.cn
'使用范围：各种需要生成图形报表，而又不能安装插件或者对速度要求比较高的系统
'联系方式：[e-mail]  或 [e-mail]     
'演示地址：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>"