画走势图,此类是根据提交的数据信息输出VML代码,产生VML图。此类可以画多条走线,算是较完美的代码吧,但就是不太美观。呵呵
类的源代码(drawclass.asp)
<%
'======================================
'类名:画走势图的类
'======================================
Class DrawClass
dim D_ColData,D_LowData
dim PicWidth,PicHeight,PicLeft,PicTop
dim X,Y
dim D_Info
dim LowUb
dim D_isShowTip
dim D_BoxData,Highest,Lowest
dim D_Position
dim D_TipColor,D_InfoColor,D_TitleColor
dim D_BoxColor,D_LineColor,D_BgColor
dim D_LineType,D_Type
'======================================
'函数功能:初始类
'======================================
Private Sub Class_Initialize
D_ColData=""
D_LowData=""
PicWidth=520
PicHeight=200
PicLeft=0
LowUb=10
D_Info=""
D_isShowTip=false
Highest=0
Lowest=0
D_BoxData=""
D_Position="left"
D_TipColor="#0000FF"
D_InfoColor="#FF0000"
D_TitleColor="#FF0000"
D_BoxColor="#000000"
D_LineColor="#AAAAAA"
D_BgColor="#D7EEFF"
D_LineType="Solid"
D_Type="1"
End Sub
'======================================
'函数功能:释放类
'======================================
Private Sub Class_Terminate
D_ColData=""
D_LowData=""
D_Info=""
D_BoxData=""
End Sub
'======================================
'以下函数对ColData和LowData变量赋值和取值
'外部用法:obj.LowData="1,1,22,3,4,4
'外部用法:obj.ColData="1,1,22,11,3"
'外部用法:obj.Title="[2002年走势图]
'======================================
'走势图的横纵坐标的数据
Public Property Let LowData(bNewValue)
D_LowData=bNewValue
End Property
Public Property Get LowData
LowData=D_LowData
End Property
Public Property Let ColData(bNewValue)
D_ColData = bNewValue
End Property
Public Property Get ColData
ColData =D_ColData
End Property
'走势图的名称
Public Property Let Title(bNewValue)
D_Info = bNewValue
End Property
Public Property Get Title
Title = D_Info
End Property
'走势图的高宽设置
Public Property Let Width(bNewValue)
PicWidth = bNewValue
End Property
Public Property Get Width
Width = PicWidth
End Property
Public Property Let Height(bNewValue)
PicHeight = bNewValue
End Property
Public Property Get Height
Height = PicHeight
End Property
Public Property Let Left(bNewValue)
PicLeft = bNewValue
End Property
Public Property Get Left
Left = PicLeft
End Property
Public Property Let Top(bNewValue)
PicTop = bNewValue
End Property
Public Property Get Top
Top = PicTop
End Property
'走势图的显示文字颜色
Public Property Let TipColor(bNewValue)
D_TipColor = bNewValue
End Property
Public Property Get TipColor
TipColor = D_TipColor
End Property
Public Property Let InfoColor(bNewValue)
D_InfoColor = bNewValue
End Property
Public Property Get InfoColor
InfoColor = D_InfoColor
End Property
Public Property Let TitleColor(bNewValue)
D_TitleColor = bNewValue
End Property
Public Property Get TitleColor
TitleColor = D_TitleColor
End Property
'走势图的线和边框颜色
Public Property Let BoxColor(bNewValue)
D_BoxColor = bNewValue
End Property
Public Property Get BoxColor
BoxColor = D_BoxColor
End Property
Public Property Let LineColor(bNewValue)
D_LineColor = bNewValue
End Property
Public Property Get LineColor
LineColor = D_LineColor
End Property
Public Property Let LineType(bNewValue)
select case bNewValue
case 1
D_LineType = "Dot"
case 2
D_LineType = "DashDot"
case else
D_LineType = "Solid"
end select
End Property
Public Property Get LineType
LineType = D_LineType
End Property
'设置显示页面的背景颜色
Public Property Let BgColor(bNewValue)
D_BgColor = bNewValue
End Property
Public Property Get BgColor
BgColor = D_BgColor
End Property
'走势图的纵坐标的标签显示位置
'值为left或1则是左边,否则是右边
Public Property Let TipPosition(bNewValue)
select case lcase(cstr(bNewValue))
case "left","1"
D_Position="left"
case else
D_Position="right"
end select
End Property
Public Property Get TipPosition
TipPosition = D_Position
End Property
'是否显示坐标的提示
Public Property Let showTip(bNewValue)
D_isShowTip = bNewValue
End Property
Public Property Get showTip
showTip = D_isShowTip
End Property
'走势图的边框参数,接收字符串和数组
Public Property Let BoxData(bNewValue)
D_BoxData = bNewValue
End Property
Public Property Get BoxData
BoxData = D_BoxData
End Property
'走势图的样式 值:1 普通带箭头的, 2 矩形包围
Public Property Let sType(bNewValue)
select case cstr(bNewValue)
case "2"
D_Type="2"
case else
D_Type="1"
end select
End Property
Public Property Get sType
sType = D_Type
End Property
'=======================================
'函数功能:显示HTML语句头
'=======================================
Private Sub ShowHead()
%>
<HTML xmlns:v>
<HEAD>
<STYLE>
v/:*{behavior:url(#default#VML);}
*{font-size:12px}
</STYLE>
</HEAD>
<BODY topmargin="0" leftmargin="0" bgcolor="<%=D_BgColor%>">
<DIV id=showdiv style="font-size:12px; Color:RED; DISPLAY: none; LEFT: 0px; PADDING-BOTTOM: 2px; PADDING-LEFT: 2px; PADDING-RIGHT: 2px; PADDING-TOP: 2px; POSITION: absolute; TABLE-LAYOUT: fixed; TOP: 0px; WHITE-SPACE: nowrap; Z-INDEX: 500"></DIV>
<script language="javascript">
<!--
//加速alt,title的显示
var oldtext="abc";
function window.onload(){
try{myid2.height=window.document.body.scrollHeight}
catch(e){}
}
function document.onmousemove(){
try{
if(event.srcElement.getAttribute('onMOver')){
showdiv.style.left=event.x-3;showdiv.style.top=event.y+document.body.scrollTop+18;if(event.srcElement.onMOver!=oldtext){oldtext=event.srcElement.onMOver;showdiv.innerText=oldtext;showdiv.style.backgroundColor='#FFF6FF'};if(showdiv.style.display=='none')showdiv.style.display=''
if(showdiv.style.posLeft+300>screen.width){showdiv.style.posLeft=520}
}
else{
if(showdiv.style.display=='')showdiv.style.display='none';}
}
catch(e){}
}
//-->
</SCRIPT>
<?xml:namespace prefix=v />
<%
End Sub
'=====================================
'函数功能:显示走势图的名称
'=====================================
Private Sub ShowInfo()
if D_Info<>"" then
PrintWord PicWidth/2.5,PicHeight+50,D_Info,D_TitleColor
end if
response.write "</Body></HTML>"
End Sub
'=====================================
'函数功能:画走势图
'=====================================
Public Sub DrawPic()
Call ShowHead
Call DarwBox
Call DarwLowPic
Call DarwColPic
Call ShowInfo
End Sub
'=====================================
'函数功能:画走势图的边框坐标线
'=====================================
Private Sub DarwBox()
dim Rec,BoxNum,i
if D_Position="left" then
PicLeft=20+PicLeft
end if
if not isArray(D_BoxData) then
if D_BoxData="" then exit sub
'不是数组则分解数据
BoxNum=split(D_BoxData,",")
Rec=ubound(BoxNum)
Highest=0
Lowest=0
'取得最大值和最小值
for i=1 to Rec
if BoxNum(i)>Highest then Highest=BoxNum(i)
if BoxNum(i)<Lowest then Lowest=BoxNum(i)
next
for i=0 to Rec
if D_Position="left" then
'画二十等分线
DrawLine 0-10,PicHeight*i/Rec,PicWidth,PicHeight*i/Rec,D_LineColor,D_LineType
'标明二十等分线数值
PrintWord PicLeft-PicLeft-20,i/Rec*PicHeight,BoxNum(i),D_TipColor
else
'画二十等分线
DrawLine 0,PicHeight*i/Rec,PicWidth,PicHeight*i/Rec,D_LineColor,D_LineType
'标明二十等分线数值
PrintWord PicWidth+15,i/Rec*PicHeight,BoxNum(i),D_TipColor
end if
next
else
'如果是数组,则取得数组的数据
'数组格式:BoxData(0)=最小值,BoxData(1)=累加值,BoxData(2)=次数
Lowest=D_BoxData(0)
Highest=Lowest+D_BoxData(1)*D_BoxData(2)
for i=0 to D_BoxData(2)
'标明二十等分线价格
if D_Position="left" then
'画二十等分线
DrawLine 0-10,PicHeight*i/D_BoxData(2),PicWidth,PicHeight*i/D_BoxData(2),D_LineColor,D_LineType
PrintWord PicLeft-PicLeft-20,i/D_BoxData(2)*PicHeight,Highest-D_BoxData(1)*i,D_TipColor
else
DrawLine 0,PicHeight*i/D_BoxData(2),PicWidth,PicHeight*i/D_BoxData(2),D_LineColor,D_LineType
PrintWord PicWidth+15,i/D_BoxData(2)*PicHeight,Highest-D_BoxData(1)*i,D_TipColor
end if
next
end if
'画走势图边框
if D_Type="1" then
if D_Position="left" then
DrawLine 0,0,PicWidth,0,D_BoxColor,D_LineType
DrawLine 0,0,0,PicHeight,D_BoxColor,"Solid"" StartArrow=""Classic"
'DrawLine PicWidth,0,PicWidth,PicHeight,D_BoxColor,"Solid"
DrawLine 0,PicHeight,PicWidth,PicHeight,D_BoxColor,"Solid"" EndArrow=""Classic"
else
DrawLine 0,0,PicWidth,0,D_BoxColor,D_LineType
'DrawLine 0,0,0,PicHeight,D_BoxColor,"Solid"" StartArrow=""Classic"
DrawLine PicWidth,0,PicWidth,PicHeight,D_BoxColor,"Solid"" StartArrow=""Classic"
DrawLine 0,PicHeight,PicWidth,PicHeight,D_BoxColor,"Solid"" StartArrow=""Classic"
end if
else
DrawLine 0,0,PicWidth,0,D_BoxColor,"Solid"
DrawLine 0,0,0,PicHeight,D_BoxColor,"Solid"
DrawLine PicWidth,0,PicWidth,PicHeight,D_BoxColor,"Solid"
DrawLine 0,PicHeight,PicWidth,PicHeight,D_BoxColor,"Solid"
end if
End Sub
'=====================================
'函数功能:画纵向的坐标线
'=====================================
Private Sub DarwColPic()
dim dRec,sData,DrawNum,i
'判断D_ColData的数据类型
if not isArray(D_ColData) then
'不是数组则如果数据为空则退出
if D_ColData="" then exit sub
'分离数据和颜色数据
sData=split(D_ColData,"|")
DrawNum=split(sData(0),",")
if ubound(sData)>0 then
Call DarwColLine(DrawNum,sData(1))
else
Call DarwColLine(DrawNum,"#000000")
end if
else
'是数组,则分别画每条数据的线
dRec=ubound(D_ColData)
for i=0 to dRec
'分离数据和颜色数据
sData=split(D_ColData(i),"|")
DrawNum=split(sData(0),",")
if ubound(sData)>0 then
Call DarwColLine(DrawNum,sData(1))
else
Call DarwColLine(DrawNum,"#000000")
end if
next
end if
End Sub
'=====================================
'函数功能:画一条数据记录的纵向的坐标线
'=====================================
Private Sub DarwColLine(dData,Color)
dim Rec
Rec=ubound(dData)
'画走势图
for i=1 to Rec+1
if i=1 then
SX=0
SY=0
else
SX=X
SY=Y
end if
Y=PicHeight-Round((dData(i-1)-Lowest)/(Highest-Lowest)*PicHeight)
X=Round((i-1)*(PicWidth/LowUb))
'不画第一次的线
if i<>1 then
'DrawPrice SX,SY,X,Y,dData(i-1),D_BoxColor
'else
DrawPrice SX,SY,X,Y,dData(i-1),Color
end if
'是否显示坐标提示
if D_isShowTip then
PrintWord X+10,Y,dData(i-1),D_InfoColor
end if
next
End Sub
'=====================================
'函数功能:画横向的坐标线
'=====================================
Private Sub DarwLowPic()
dim ii,tmpLow
if D_LowData<>"" then
'分解LowData的数据,LowData的数据格式为:LowData="文字,文字,文字"
tmpLow=split(D_LowData,",")
'显示文字
LowUb=ubound(tmpLow)
for ii=0 to LowUb
X=Round(ii/LowUb*PicWidth)
DrawLine X,PicHeight,X,PicHeight+5,"#808080","Solid"
PrintWord X,PicHeight+15,tmpLow(ii),D_InfoColor
next
end if
End Sub
'=====================================
'函数功能:画线
'=====================================
Private Sub DrawLine(SX,SY,X,Y,C,S)
'response.write s&"<br>"
response.write "<v:line style=""POSITION:absolute;LEFT:"&(PicLeft+10)&";TOP:"&(PicTop+10)&""" from="""&SX&","&SY&""" to="""&X&","&Y&""" strokecolor="""&C&""" strokeweight=""1pt""><v:stroke dashstyle="""&S&"""/></v:line>"
response.write vbcrlf
End Sub
'=====================================
'自定义函数:画线(带alt提示功能)
'=====================================
Private Sub DrawPrice(SX,SY,X,Y,Num,C)
response.write "<v:line onMOver="""&Num&""" style=""POSITION:absolute;LEFT:"&(PicLeft+10)&";TOP:"&(PicTop+10)&""" from="""&SX&","&SY&""" to="""&X&","&Y&""" strokecolor="""&C&""" strokeweight=""1pt""><v:stroke EndArrow=""Oval""/></v:line>"
response.write vbcrlf
End Sub
'=====================================
'显示文本
'=====================================
Private Sub PrintWord(X,Y,Word,C)
dim sX,sY
sX=PicLeft+X
sY=PicTop+Y
response.write "<SPAN style=""LEFT:"&sX&";TOP:"&sY&";COLOR:"&C&";FONT-FAMILY:宋体;POSITION:absolute"">"&Word&"</SPAN>"
response.write vbcrlf
End Sub
End Class
%>
样例代码(draw.asp)
<!--#Include file="DrawClass.asp"-->
<%
dim data(2),colData(2)
'定义对象
Set Darw=new DrawClass
'显示底坐标
Darw.LowData="一月,二月,三月,四月,五月,六月"
'走势图的纵坐标数据
'如果是数组表示:则data(0)表示最小值 data(1)累加值 data(2)次数
'如果是字符串表示:则格式为data="数据1,数据2,数据3,...." 里面的数据一定要为数字值
data(0)=0
data(1)=25
data(2)=20
Darw.BoxData=data
'DrawClass类里的ColData属性的值格式是:"数据,数据,数据,数据|颜色值"
colData(0)="60,200,190,340,240,500|#000000"
colData(1)="160,80,120,250,390,450|#FF0000"
colData(2)="300,100,220,90,250,350|#0000FF"
Darw.ColData=colData
'走势图的标题
Darw.Title="[2003上半年生产总值]"
'走势图的宽度和高度和位置
Darw.Width=500
Darw.Height=300
Darw.Left=220
Darw.Top=90
'纵坐标的显示位置 "left"左边 "right"右边
Darw.TipPosition="left"
'是否显示坐标提示
'Darw.showTip=True
'设置纵坐标的文字颜色
Darw.TipColor="#FF0F84"
'设置横坐标的文字颜色
Darw.InfoColor="#FF0000"
'设置标题的文字颜色
Darw.TitleColor="#FF0000"
'设置图的边框颜色
Darw.BoxColor="#362832"
'设置图的分隔线颜色
Darw.LineColor="#0F3300"
'设置分隔线的样式 1 点划线 2横点划线 其它值 细直线
Darw.LineType=1
'设置图型的样式 1普通带箭头 2 矩形包围
Darw.sType=1
'设置显示页面的背景颜色
'Darw.BgColor="#00000E"
'画走势图
Darw.DrawPic
Set Darw=nothing
%>