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

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

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

只是现在只支持IE。

源码在下。相在代码：

 

<%
' 这段注释不影响性能和速度，请保留
' 开发人：宋新成
' 形式：开源
' 官方网址：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> "
            
            str = str & " <v:Rect style= "" left: " & widthx & " ;top: " & ((i * lenheight) + 150 ) & " ;width:1000;height: " & lenheight & """  filled= "" f ""  stroked= "" f "" > <v:TextBox inset= "" 10pt,10pt,10pt,10pt ""  style= "" font-size:9pt; "" ><div align= "" left ""  styel= "" background-color:#0033FF; "" > " & (i + 1 ) & "    " & keys & " : " & val & " </div></v:TextBox></v:Rect> "
            
            i = i + 1
        next
        GetContent = str
    End Function
    
    Function CreateLegend()
        Dim str
        CreateLegend = str
    End Function
    
    
    Function CreateLine(dc,w,h)
        dim num,str,keys,width,height,lenheight
        dim max,val,i,left_pad,top
        dim keyarr,nval
        dim sx,sy,ex,ey
        dim widthx,heightx,topspa
        max = GetMaxValue(dc)
        
        keyarr = dc.keys()
        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
        i = 0
         for  i = 1  to ubound(keyarr)
            sx = (i * width) + 10
            val = dc(keyarr(i - 1 ))
            nval = dc(keyarr(i))
            height = (val * heightx) / max
            sy = heightx - height + topspa
            ex = sx + width
            ey = heightx - (nval * heightx) / max + topspa
            str = str & " <v:line from=' " & sx & " , " & sy & " ' to=' " & ex & " , " & ey & " 'style='z-index:10;' strokeweight='0.1pt' strokecolor=' " &  lcolor  & " '></v:line> "
            str = str & " <v:Rect style= "" left: " & (sx - 100 ) & " ;top: " &  (heightx + topspa)  & " ;width:1000;height:100 ""  filled= "" f ""  stroked= "" f "" > <v:TextBox inset= "" 10pt,10pt,10pt,10pt ""  style= "" font-size:9pt; "" ><div align= "" left "" > " & (i) & " </div></v:TextBox></v:Rect> "
            
            str = str & " <v:Rect style= "" left: " & widthx & " ;top: " & (((i - 1 ) * lenheight) + 150 ) & " ;width:1000;height: " & lenheight & """  filled= "" f ""  stroked= "" f "" > <v:TextBox inset= "" 10pt,10pt,10pt,10pt ""  style= "" font-size:9pt; "" ><div align= "" left ""  styel= "" background-color:#0033FF; "" > " & (i) & "    " & keyarr(i - 1 ) & " : " & val & " </div></v:TextBox></v:Rect> "
             if  (i = (num - 1 )) then
                str = str & " <v:Rect style= "" left: " & (ex - 100 ) & " ;top: " &  (heightx + topspa)  & " ;width:1000;height:100 ""  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> "
            
                str = str & " <v:Rect style= "" left: " & widthx & " ;top: " & (((i) * lenheight) + 150 ) & " ;width:1000;height: " & lenheight & """  filled= "" f ""  stroked= "" f "" > <v:TextBox inset= "" 10pt,10pt,10pt,10pt ""  style= "" font-size:9pt; "" ><div align= "" left ""  styel= "" background-color:#0033FF; "" > " & (i + 1 ) & "    " & keyarr(i) & " : " & nval & " </div></v:TextBox></v:Rect> "
            
            end  if
            
        next
        CreateLine = str
    End Function
    
    
    Function createPie(dc,w,h)
        Dim str
        Dim num,i,total,valarr,keyarr,val,lenheight
        Dim radio,color
        Dim k1,k2,rotates,adjs
        Dim zIndex
        dim width
        dim height
        zIndex = 10
        k1 = 180
        valarr = dc.items()
         for  i = 0  to ubound(valarr)
            total = total + valarr(i)
        next
        
        dim widthx,heightx,topspa
        heightx = int (h / 500 * 2500 ) + 1
        widthx = int (w / 700 * 4700 ) + 80
        topspa = int (h / 500 * 200 ) + 1
        height = int (h / 500 * 2300 )
        keyarr = dc.keys()
        lenheight = 120
         for  i = 0  to ubound(keyarr)
            val = dc(keyarr(i))
            radio = cdbl(formatnumber((val / total) * 100000 ) / 100000 )
            color = generateColor(i)
            k2 =   360   *  radio  / 2
            rotates  =  k1  +  k2
             if  (rotates >=   360 ) then
                rotates  =  rotates  -   360
            end  if
            adjs  =  (  - 11796480   *  radio  +   5898240  )
             ' response.Write("radio"&i&":"&radio&":"&val&"<br>")
            str=str&"<div><v:shape id=""pie"&i&"""  οnmοuseοver=""moveup(pie"&i&",40, ' txt " &i& "' ,rec"&i&");"" οnmοuseοut=""movedown(pie"&i&",40, ' txt " &i& "' ,rec"&i&");"" title="""&keyarr(i)&":"&xRound(val,1)&"  比例:"&xRound(radio*100,1)&"%"" style=""Z-INDEX: "&zIndex&"; LEFT: 1000px; WIDTH: "& height &"px; POSITION: absolute; TOP: 200px; HEIGHT: "& height &"px; rotation:"&rotates&"""  ; type = ""#Cake_3D"" coordsize = ""21600,21600"" fillcolor = """&color&""" adj = """&adjs&",0""><v:fill rotate = ""t"" type = ""gradient"" opacity = ""60293f"" color2 = ""fill lighten(120)"" o:opacity2 = ""60293f"" angle = ""-135"" focus = ""100%"" method = ""linear sigma""></v:fill></v:shape></div>"
            str=str&"<v:rect id=""rec"&i&""" style=""display:none;left:"& widthx &";top:"&(((i)*lenheight)+220)&";width:900;height:"&(lenheight-20)&""" fillcolor =""#efefef"" strokecolor = ""#ccc""><v:fill rotate = ""t"" type = ""gradient"" opacity = ""39321f"" color2 = ""fill darken(118)"" o:opacity2 = ""39321f"" focus = ""100%"" method = ""linear sigma""></v:fill></v:rect>"
            str=str&"<v:Rect  style=""left:"& widthx &";top:"&(((i)*lenheight)+150)&";width:1000;height:"&lenheight&""" filled=""f"" stroked=""f""> <v:TextBox inset=""10pt,10pt,10pt,10pt"" style=""font-size:9pt;""><div align=""left"" styel=""background-color:#0033FF;"">"&(i)&"  "&keyarr(i)&":"&val&"</div></v:TextBox></v:Rect>"
             k1= k1 + k2 * 2
            if (k1 >= 360) then
                k1 = k1 - 360
            end if
            if (k1 > 180) then
                zIndex = zIndex + 1
            else
                zIndex = zIndex - 1
            end if
        next
        createPie=str
    End Function
    
    Function wirtePieHeader()
        Dim str
        str="<v:shapetype id=Cake_3D coordsize = ""21600,21600"" o:spt = ""95"" path = "" al10800,10800@0@0@2@14 ae10800,10800,10800,10800@3@15 x e"" adj = ""11796480,5400""></v:shapetype>"
        str=str&"<v:shapetype id=3dtxt coordsize = ""21600,21600"" o:spt = ""136"" path = "" m@7,0 l@8,0 m@5,21600 l@6,21600 e"" adj = ""10800"">"
        str=str&"<v:path o:connectangles=""270,180,90,0"" o:connectlocs=""@9,0;@10,10800;@11,21600;@12,10800"" textpathok = ""t"" o:connecttype = ""custom""></v:path>"
        str=str&"<v:textpath on = ""t"" fitshape = ""t""></v:textpath>"
        str=str&"<o:lock shapetype=""t"" text=""t"" v:ext=""edit""></o:lock>"
        str=str&"</v:shapetype>"
        wirtePieHeader=str
    End Function
    
    Function xRound(num,n)
        dim i
        for i=0 to n
            num=num*10
        next
        num=Cdbl(Formatnumber(num))
        for i=0 to n
            num=num/10
        next
        xRound=num
    end Function
    
    function generateColor(i)
        randomize
        dim r,g,b
        r=int(rnd*255)
        g=int(rnd*255)
        b=int(rnd*255)
        if((i mod 3)=0) then
            r=((r*i) mod 255)+i
        else
            r=((r*i) mod 255)+255-i
        end if
        
        if((i mod 3)=2) then
            g=((g*i) mod 255)+i
        else
            g=((g*i) mod 255)+255-i
        end if
        
        if((i mod 3)=1) then
            b=((b*i) mod 255)+i
        else
            b=((b*i) mod 255)+255-i
        end if
        generateColor="rgb("&r&","&g&","&b&")"
    end function
end class
%>

 不敢独享,大家一齐用吧！！

附件

2007-6-7 10:53

qwq.gif (72.9 KB)
  图

aspvml.rar (4.89 KB)
  源码下载