VB 输出曲线图
0 Reply , Posted in 程序代码 on 2017 28, 2017
'**************************************************
'*******************输*出*曲*线*图*形**************
'**************************************************
Public Sub Print_Curve(pPic As PictureBox, pClsDatas As Cls_SNPointS, _
ByVal X_MaxValue As String, ByVal Y_MaxValue As String)
Dim X As Double, Y As Double
Dim W As Double, H As Double
Dim i As Double
Dim HZB_MaxValue As Double
Dim ZZB_MaxValue As Double
Dim ZZB_Start As Double
Dim HZB_Start As Double
'坐标轴长度
Dim Vertical_Y As Double
Dim Horizontal_X As Double
'坐标数据间的距离
Dim Y_Len As Double
Dim X_Len As Double
Dim tmpcls As Cls_SNPoint
Dim tmpLen_X As Integer '临时距离
Dim tmpLen_Y As Integer '临时距离
pPic.Cls
pPic.CurrentX = 1800
pPic.CurrentY = 1500
X = 1000: Y = 300
pPic.ForeColor = &H0
'获得坐标系的坐标值
ZZB_MaxValue = Val(Y_MaxValue)
HZB_MaxValue = Val(X_MaxValue)
ZZB_Start = 0: HZB_Start = 0
Vertical_Y = ZZB_MaxValue - ZZB_Start
Horizontal_X = HZB_MaxValue - HZB_Start
W = 6000: H = 3200
pPic.DrawWidth = 2
pPic.DrawStyle = 0 '实线
'绘制格网的外围边框
pPic.Line (X, Y)-(X + W, Y)
pPic.Line (X + W, Y)-(X + W, Y + H)
pPic.Line (X, Y)-(X, Y + H)
pPic.Line (X, Y + H)-(X + W, Y + H)
'绘制格网的内边框
pPic.DrawStyle = 2
pPic.DrawWidth = 1 '虚线
For i = 1 To 4
pPic.Line (X + i * W / 5, Y)-(X + i * W / 5, Y + H)
pPic.Line (X, Y + i * H / 5)-(X + W, Y + i * H / 5)
Next i
'绘制格网的坐标系Y坐标
For i = 0 To 5 '画坐标 y
pPic.FontName = "Arial"
pPic.FontSize = 8
pPic.ForeColor = &H0
Y_Len = Format(ZZB_Start - i * Vertical_Y / 5, "##0.##")
pPic.CurrentX = X - 100 - Len(Y_Len) * 90
pPic.CurrentY = (Y - 100) + i * H / 5
'打印Y坐标数据
pPic.Print Val(Y_ZB(i).Caption)
Next i
'绘制格网的坐标系X坐标
For i = 0 To 5 '画坐标 x
pPic.FontName = "Arial"
pPic.FontSize = 8
pPic.ForeColor = &H0
X_Len = Format(HZB_Start + i * Horizontal_X / 5, "##0.##")
pPic.CurrentX = X + i * W / 5 - 200
pPic.CurrentY = Y + H + 200
'打印X坐标数据
pPic.Print Val(X_ZB(i).Caption)
Next i
'打开文件，读取数据，绘制数据点
'设置打印起点的各个属性
pPic.ForeColor = &HFF '& 'red
pPic.FontSize = 8
pPic.FontName = "Arial"
pPic.CurrentX = X
pPic.CurrentY = Y + H
X = pPic.CurrentX
Y = pPic.CurrentY
pPic.DrawWidth = 1
pPic.DrawStyle = 0
If pClsDatas.Count < 1 Then Exit Sub
Set tmpcls = pClsDatas(1)
pPic.CurrentX = X + CInt((tmpcls.SN_X - HZB_Start) * W / Horizontal_X)
pPic.CurrentY = Y + CInt((-1) * (tmpcls.SN_Y - ZZB_Start) * H / Vertical_Y)
For Each tmpcls In pClsDatas
tmpLen_X = CInt((tmpcls.SN_X - HZB_Start) * W / Horizontal_X)
tmpLen_X = X + tmpLen_X
tmpLen_Y = CInt((-1) * (tmpcls.SN_Y - ZZB_Start) * H / Vertical_Y)
tmpLen_Y = Y + tmpLen_Y
tmpLen_X = CInt(tmpLen_X)
tmpLen_Y = CInt(tmpLen_Y)
pPic.Line -(tmpLen_X, tmpLen_Y), vbRed
pPic.Circle (tmpLen_X, tmpLen_Y), 20, vbBlue '绘制一个小圆 表示单点
Next
'''''''''''''''''''''''''''''''''''''
pPic.FontSize = 8
pPic.FontName = "Arial"
pPic.ForeColor = &H0
pPic.CurrentX = 3000
pPic.CurrentY = 4000
pPic.Print "应力(MPa)-循环次数(T)"
End Sub
