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

最新推荐文章于 2008-03-07 14:48:00 发布

转载最新推荐文章于 2008-03-07 14:48:00 发布 · 971 阅读

文章标签：

#asp #header #function #destructor #path #360

web开发专栏收录该内容

18 篇文章

订阅专栏

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

浏览页：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> "

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> "

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

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

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

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)

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&""" onmouseover=""moveup(pie"&i&",40, ' txt " &i& "' ,rec"&i&");"" onmouseout=""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

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

num=Cdbl(Formatnumber(num))

for i=0 to n

num=num/10