VB绘制曲线图
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
一个画曲线的函数
Const XMargin = 20 'XMargin --- X轴预留像素
Const YMargin = 20 'YMargin --- Y轴预留像素
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function Polyline Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
'一个画曲线的函数
'XData --- 存放X轴数据
'YData --- 存放Y轴数据
'PicObj --- 画图形的控件
'ShowDot --- 是否显示接点
'ShowBorder --- 是否显示边框
Private Function DrawLine(XData() As Double, YData() As Double, PicObj As PictureBox, Optional ShowDot As Boolean = True, Optional ShowBorder As Boolean = True) As Boolean
On Error GoTo ErrFlag
Dim TotalData As Long '所画曲线的总点数
Dim i As Long, j As Long
Dim XMax As Double, XMin As Double, XScale As Double
Dim YMax As Double, YMin As Double, YScale As Double
Dim dblTemp As Double
Dim XY() As POINTAPI
DrawLine = False
PicObj.Cls
PicObj.AutoRedraw = True
PicObj.ScaleMode = 3 '模式设为像素
'如果画图控件的长、宽不够，则自动调整
If PicObj.ScaleWidth < XMargin * 2 Then PicObj.ScaleWidth = XMargin * 2 + 50
If PicObj.ScaleHeight < YMargin * 2 Then PicObj.ScaleHeight = YMargin * 2 + 50
'如果X与Y的数据个数不一致则结束
If UBound(XData) <> UBound(YData) Then
MsgBox "X与Y的数据个数不一致", vbOKOnly + vbInformation
Exit Function
End If
'取得总数据个数，如果小于等于1则结束
TotalData = UBound(XData) - LBound(XData)
If TotalData <= 1 Then
MsgBox "数据个数小于1, 不可以画曲线", vbOKOnly + vbInformation
Exit Function
End If
'取得XData的最小值，最大值，并设置X轴的缩放比例
XMax = -0
XMin = 0
For i = LBound(XData) To UBound(XData)
If XMax < XData(i) Then XMax = XData(i)
If XMin > XData(i) Then XMin = XData(i)
Next
If XMax - XMin < 0.0000001 Then
MsgBox "X数据相同, 不可以画曲线", vbOKOnly + vbInformation
Exit Function
Else
XScale = (PicObj.ScaleWidth - XMargin * 2) / (XMax - XMin) End If
'取得YData的最小值，最大值，并设置X轴的缩放比例
YMax = -0
YMin = 0
For i = LBound(YData) To UBound(YData)
If YMax < YData(i) Then YMax = YData(i)
If YMin > YData(i) Then YMin = YData(i)
Next
If YMax - YMin < 0.0000001 Then
MsgBox "Y数据相同, 不可以画曲线", vbOKOnly + vbInformation
Exit Function
Else
YScale = (PicObj.ScaleHeight - YMargin * 2) / (YMax - YMin) End If
'根据XScale, YScale 确定绘图的数据
ReDim XY(TotalData)
j = 0
For i = LBound(YData) To UBound(YData)
XY(j).x = XMargin + (XData(i) - XMin) * XScale
XY(j).y = PicObj.ScaleHeight - YMargin - (YData(i) - YMin) * YScale
j = j + 1
Next
'画曲线
Polyline PicObj.hdc, XY(0), TotalData + 1
PicObj.DrawWidth = 4
'显示接点
If ShowDot Then
For i = 0 To TotalData
PicObj.PSet (XY(i).x, XY(i).y)
Next
End If
PicObj.DrawWidth = 1
If ShowBorder Then
Rectangle PicObj.hdc, XMargin, YMargin, PicObj.ScaleWidth - XMargin, PicObj.ScaleHeight - YMargin
End If
DrawLine = True
Exit Function
ErrFlag:
MsgBox Err.Descrīption, vbOKOnly + vbCritical
DrawLine = False