Private Const X_Axe = 0.5 'X轴原点位于窗口的水平位置比例
Private Const Y_Axe = 0.6 'Y轴原点位于窗口的垂直位置比例
Private Const ScaleRate = 30'多少像素代表一个单位长度
Private Const DrawColor = vbRed '曲线颜灶枣色
Private ErrExp As Boolean '当表达式发生错误时，会置True(比如函数在此点无有效值)
Private Sub Form_Load()
Me.Show
Me.Cls
Call DrawAxe
Call DrawCoordinate
End Sub
Private Function Expression(ByVal X As Double) As Double'公式函数可以是任意内容
ErrExp = False '进入时，必须重置此标志为False
If X >0 Then '这里代码任意，也搭辩可以是Expression = 2 * X ^ 2 + 2 * X + 1之类的
Expression = Log(X)
Else
Expression = 0
ErrExp = True
End If
End Function
Private Sub DrawCoordinate()'绘制曲线过程
Dim i As Long
Dim Last(1 To 2) As Long, This(1 To 2) As Long
Dim X_offset As Long
Dim Y_offset As Long
Me.ScaleMode = vbPixels
X_offset = Me.ScaleWidth * X_Axe
Y_offset = Me.ScaleHeight * Y_Axe
'设置一个初始值
Last(1) = 0
Last(2) = -Expression((0 - X_offset) / ScaleRate) * ScaleRate
i = 0
While i <= Me.ScaleWidth
'取下一点的值
This(1) = i
This(2) = -Expression((i - X_offset) / ScaleRate) * ScaleRate
'判断表达式是否出错
If ErrExp = True Then
'出错的情况下，循环直到没有错误或者超出范隐枝拆围为止
While ErrExp = True And i <= Me.ScaleWidth
i = i + 1
This(1) = i
This(2) = -Expression((i - X_offset) / ScaleRate) * ScaleRate
Wend
'重置起点
Last(1) = This(1)
Last(2) = This(2)
End If
'画线
Me.Line (Last(1), Last(2) + Y_offset)-(This(1), This(2) + Y_offset), DrawColor
Last(1) = This(1)
Last(2) = This(2)
i = i + 1
Wend
End Sub
Private Sub DrawAxe() '绘制坐标的过程
Dim X_offset As Long
Dim Y_offset As Long
Dim i As Long
Me.ScaleMode = vbPixels '取单位长度为像素
X_offset = Me.ScaleWidth * X_Axe'计算坐标轴轴位置
Y_offset = Me.ScaleHeight * Y_Axe
'绘制坐标轴
Me.Line (X_offset, 0)-(X_offset, Me.ScaleHeight)
Me.Line (0, Y_offset)-(Me.ScaleWidth, Y_offset)
'绘制坐标线
For i = X_offset + ScaleRate To Me.ScaleWidth Step ScaleRate
Me.Line (i, 0)-(i, Me.ScaleHeight), vbWhite
Next i
For i = X_offset - ScaleRate To 0 Step -ScaleRate
Me.Line (i, 0)-(i, Me.ScaleHeight), vbWhite
Next i
For i = Y_offset + ScaleRate To Me.ScaleHeight Step ScaleRate
Me.Line (0, i)-(Me.ScaleWidth, i), vbWhite
Next i
For i = Y_offset - ScaleRate To 0 Step -ScaleRate
Me.Line (0, i)-(Me.ScaleWidth, i), vbWhite
Next i
End Sub
Private Sub Form_Resize()
Me.Cls
Call DrawAxe
Call DrawCoordinate
End Sub
以下给出用于在迟伍pictruebox以LINE语句画曲线的代码:Option Explicit'变量定义
Private gyhDate As String
Private chaxun11 As String
Private chaxun2 As String
Private zsl As Integer
Private wy_wy As Double
Private br_br As Double
Private quexian(9, 6000) As Variant'曲线变量
Private zsl1 As Integer
Private zsl11 As Integer
Private i As Integer
Private j As Integer
Private X As Integer
Private Y As Integer
Private fnt As Integer
Private txt As Variant
Private dd As Variant
'曲线显示文字函数
Public Function xp(colvb As Variant, xx As Variant, yy As Variant, txt As Variant)
Picture1.ForeColor = colvb 'QBColor(14)
Picture1.CurrentX = xx
Picture1.CurrentY = yy
Picture1.Print txt '
End Function
'数据查询
Private Sub DataGrid3_Click()
gyhDate = Adodc3.Recordset(0)
chaxun1 = "select * from jishijilu where gyh_riqi='" &gyhDate &"' order by shijian"
mdh = chaxun1
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0Data Source=C:\Ldgz\wd.mdbPersist Security Info=False"
Adodc1.RecordSource = mdh
Adodc1.Refresh
Adodc1.Recordset.MoveLast
'Text1 = gyhDate
chaxun11 = "select * from jishijilu where gyh_riqi='" &gyhDate &"'"
chaxun2 = " order by gyh_riqi,shijian"拦旦兆
mdh = chaxun11 &chaxun2
Adodc2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0Data Source=C:\简租Ldgz\wd.mdbPersist Security Info=False"
Adodc2.RecordSource = mdh
Adodc2.Refresh
zsl = Adodc2.Recordset.RecordCount
Text2 = zsl
Adodc2.Recordset.MoveFirst
'将数据赋值于quexian(*, *)变量
For i = 0 To zsl - 1
quexian(0, i) = Adodc2.Recordset(0)
For j = 2 To 9
quexian(j, i) = Adodc2.Recordset(j)
Next j
Adodc2.Recordset.MoveNext
Next i
cmdQuxian.SetFocus
cmdRefh.Enabled = True
cmdPrint.Enabled = True
DataGrid3.Visible = False
End Sub
'初始化
Private Sub Form_Load()
chaxun1 = "select gyh_riqi from jishijilu where gyh_riqi >'" &"" &"' group by gyh_riqi"
mdh = chaxun1
Adodc3.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0Data Source=C:\Ldgz\wd.mdbPersist Security Info=False"
Adodc3.RecordSource = mdh
Adodc3.Refresh
Adodc3.Recordset.MoveLast
Picture2.Height = 6765
Picture1.Visible = False
cmdRefh.Enabled = False
End Sub
'显示曲线代码
Private Sub cmdQuxian_Click()
'HScroll1.Visible = True
DataGrid1.Visible = False
Adodc1.Visible = False
DataGrid3.Visible = False
Adodc3.Visible = False
Picture2.Height = 7245
Picture1.Visible = True
Picture1.Cls
'坐标文字
colvb = vbWhite
xx = 100
yy = 150
txt = "℃"
wp = xp(colvb, xx, yy, txt)
yy = 350
txt = "100"
wp = xp(colvb, xx, yy, txt)
xx = 200
yy = 1850
txt = "50"
wp = xp(colvb, xx, yy, txt)
yy = 3350
xx = 300
txt = "0"
wp = xp(colvb, xx, yy, txt)
xx = 100
yy = 4850
txt = "-50"
wp = xp(colvb, xx, yy, txt)
xx = 0
yy = 6350
txt = "-100"
wp = xp(colvb, xx, yy, txt)
xx = 10800 + 100
yy = 150
txt = "℃"
wp = xp(colvb, xx, yy, txt)
yy = 350
txt = "100"
wp = xp(colvb, xx, yy, txt)
xx = 10800 + 200
yy = 1850
txt = "50"
wp = xp(colvb, xx, yy, txt)
yy = 3350
xx = 10800 + 300
txt = "0"
wp = xp(colvb, xx, yy, txt)
xx = 10800 + 100
yy = 4850
txt = "-50"
wp = xp(colvb, xx, yy, txt)
xx = 10800 + 0
yy = 6350
txt = "-100"
wp = xp(colvb, xx, yy, txt)
'真空坐标
colvb = vbRed
xx = 11400
yy = 150
txt = "Pa"
wp = xp(colvb, xx, yy, txt)
yy = 350
txt = "1000"
wp = xp(colvb, xx, yy, txt)
xx = 11500
yy = 1850
txt = "100"
wp = xp(colvb, xx, yy, txt)
yy = 3350
xx = 11600
txt = "10"
wp = xp(colvb, xx, yy, txt)
xx = 11700
yy = 4850
txt = "1"
wp = xp(colvb, xx, yy, txt)
xx = 11500
yy = 6350
txt = "0.1"
wp = xp(colvb, xx, yy, txt)
xx = 500
yy = 150
txt = "Pa"
wp = xp(colvb, xx, yy, txt)
yy = 350
txt = "1000"
wp = xp(colvb, xx, yy, txt)
yy = 150
xx = 2200
txt = "6hr"
wp = xp(colvb, xx, yy, txt)
xx = 4000
txt = "12hr"
wp = xp(colvb, xx, yy, txt)
xx = 5800
txt = "18hr"
wp = xp(colvb, xx, yy, txt)
xx = 7600
txt = "24hr"
wp = xp(colvb, xx, yy, txt)
xx = 9400
txt = "30hr"
wp = xp(colvb, xx, yy, txt)
xx = 13000
txt = "42hr"
wp = xp(colvb, xx, yy, txt)
xx = 14800
txt = "48hr"
wp = xp(colvb, xx, yy, txt)
xx = 16600
txt = "54hr"
wp = xp(colvb, xx, yy, txt)
xx = 18400
txt = "60hr"
wp = xp(colvb, xx, yy, txt)
xx = 20200
txt = "66hr"
wp = xp(colvb, xx, yy, txt)
xx = 22000
txt = "72hr"
wp = xp(colvb, xx, yy, txt)
xx = 23800
txt = "78hr"
wp = xp(colvb, xx, yy, txt)
xx = 25600
txt = "84hr"
wp = xp(colvb, xx, yy, txt)
xx = 600
yy = 1850
txt = "100"
wp = xp(colvb, xx, yy, txt)
yy = 3350
xx = 11600
txt = "10"
wp = xp(colvb, xx, yy, txt)
xx = 700
yy = 4850
txt = "1"
wp = xp(colvb, xx, yy, txt)
xx = 600
yy = 6350
txt = "0.1"
wp = xp(colvb, xx, yy, txt)
xx = 22100
yy = 350
txt = "1000"
wp = xp(colvb, xx, yy, txt)
yy = 1850
txt = " 100"
wp = xp(colvb, xx, yy, txt)
yy = 3350
txt = " 10"
wp = xp(colvb, xx, yy, txt)
yy = 4850
txt = " 1"
wp = xp(colvb, xx, yy, txt)
yy = 6350
txt = " 0.1"
wp = xp(colvb, xx, yy, txt)
'画格
Picture1.ForeColor = vbWhite
Picture1.Line (450, 700)-(500, 700)
Picture1.Line (450, 1000)-(500, 1000)
Picture1.Line (450, 1300)-(500, 1300)
Picture1.Line (450, 1600)-(500, 1600)
Picture1.ForeColor = vbRed
Picture1.Line (500, 566.7)-(550, 566.7)
Picture1.Line (500, 733.3)-(550, 733.3)
Picture1.Line (500, 900)-(550, 900)
Picture1.Line (500, 1066.7)-(550, 1066.7)
Picture1.Line (500, 1233.3)-(550, 1233.3)
Picture1.Line (500, 1400)-(550, 1400)
Picture1.Line (500, 1566.7)-(550, 1566.7)
Picture1.Line (500, 1733.3)-(550, 1733.3)
Picture1.Line (500, 2066.7)-(550, 2066.7)
Picture1.Line (500, 2233.3)-(550, 2233.3)
Picture1.Line (500, 2400)-(550, 2400)
Picture1.Line (500, 2566.7)-(550, 2566.7)
Picture1.Line (500, 2733.3)-(550, 2733.3)
Picture1.Line (500, 2900)-(550, 2900)
Picture1.Line (500, 3066.7)-(550, 3066.7)
Picture1.Line (500, 3233.3)-(550, 3233.3)
Picture1.Line (500, 3566.7)-(550, 3566.7)
Picture1.Line (500, 3733.3)-(550, 3733.3)
Picture1.Line (500, 3900)-(550, 3900)
Picture1.Line (500, 4066.7)-(550, 4066.7)
Picture1.Line (500, 4233.3)-(550, 4233.3)
Picture1.Line (500, 4400)-(550, 4400)
Picture1.Line (500, 4566.7)-(550, 4566.7)
Picture1.Line (500, 4733.3)-(550, 4733.3)
Picture1.Line (500, 5066.7)-(550, 5066.7)
Picture1.Line (500, 5233.3)-(550, 5233.3)
Picture1.Line (500, 5400)-(550, 5400)
Picture1.Line (500, 5566.7)-(550, 5566.7)
Picture1.Line (500, 5733.3)-(550, 5733.3)
Picture1.Line (500, 5900)-(550, 5900)
Picture1.Line (500, 6066.7)-(550, 6066.7)
Picture1.Line (500, 6233.3)-(550, 6233.3)
Picture1.ForeColor = vbWhite
Picture1.Line (450, 400)-(25700, 400)
Picture1.Line (450, 1900)-(25700, 1900)
Picture1.Line (450, 3400)-(25700, 3400)
Picture1.Line (450, 4900)-(25700, 4900)
Picture1.Line (450, 6400)-(25700, 6400)
Picture1.Line (450, 2200)-(500, 2200)
Picture1.Line (450, 2500)-(500, 2500)
Picture1.Line (450, 2800)-(500, 2800)
Picture1.Line (450, 3100)-(500, 3100)
Picture1.Line (450, 3700)-(500, 3700)
Picture1.Line (450, 4000)-(500, 4000)
Picture1.Line (450, 4300)-(500, 4300)
Picture1.Line (450, 4600)-(500, 4600)
Picture1.Line (450, 5200)-(500, 5200)
Picture1.Line (450, 5500)-(500, 5500)
Picture1.Line (450, 5800)-(500, 5800)
Picture1.Line (450, 6100)-(500, 6100)
Picture1.Line (500, 400)-(500, 6400)
Picture1.Line (500 + 0, 400)-(500 + 0, 6400)
Picture1.Line (1400 + 0, 400)-(1400 + 0, 6400)
Picture1.Line (2300 + 0, 400)-(2300 + 0, 6400)
Picture1.Line (3200 + 0, 400)-(3200 + 0, 6400)
Picture1.Line (4100 + 0, 400)-(4100 + 0, 6400)
Picture1.Line (5000 + 0, 400)-(5000 + 0, 6400)
Picture1.Line (5900 + 0, 400)-(5900 + 0, 6400)
Picture1.Line (6800 + 0, 400)-(6800 + 0, 6400)
Picture1.Line (7700 + 0, 400)-(7700 + 0, 6400)
Picture1.Line (8600 + 0, 400)-(8600 + 0, 6400)
Picture1.Line (9500 + 0, 400)-(9500 + 0, 6400)
Picture1.Line (10400 + 0, 400)-(10400 + 0, 6400)
Picture1.Line (11300, 400)-(11300, 6400)
Picture1.Line (12200, 400)-(12200, 6400)
Picture1.Line (13100, 400)-(13100, 6400)
Picture1.Line (14000, 400)-(14000, 6400)
Picture1.Line (14900, 400)-(14900, 6400)
Picture1.Line (15800, 400)-(15800, 6400)
Picture1.Line (16700, 400)-(16700, 6400)
Picture1.Line (17600, 400)-(17600, 6400)
Picture1.Line (18500, 400)-(18500, 6400)
Picture1.Line (19400, 400)-(19400, 6400)
Picture1.Line (20300, 400)-(20300, 6400)
Picture1.Line (21200, 400)-(21200, 6400)
Picture1.Line (22100, 400)-(22100, 6400)
Picture1.Line (23000, 400)-(23000, 6400)
Picture1.Line (23900, 400)-(23900, 6400)
Picture1.Line (24800, 400)-(24800, 6400)
Picture1.Line (25700, 400)-(25700, 6400)
'画曲线
For j = 0 To zsl - 1
Picture1.Line (j * 5 + 500, quexian(2, j) * -30 + 3399)-(j * 5 + 500, quexian(2, j) * -30 + 3401), vbRed, BF
Picture1.Line (j * 5 + 500, quexian(3, j) * -30 + 3399)-(j * 5 + 500, quexian(3, j) * -30 + 3401), QBColor(7), BF
Picture1.Line (j * 5 + 500, quexian(4, j) * -30 + 3399)-(j * 5 + 500, quexian(4, j) * -30 + 3401), vbBlack, BF
Picture1.Line (j * 5 + 500, quexian(5, j) * -30 + 3399)-(j * 5 + 500, quexian(5, j) * -30 + 3401), vbYellow, BF
Picture1.Line (j * 5 + 500, quexian(6, j) * -30 + 3399)-(j * 5 + 500, quexian(6, j) * -30 + 3401), vbGreen, BF
'准对数处理
If quexian(8, j) <1 Then
wy_wy = 0 + 166.7
br_br = 55
ElseIf quexian(8, j) >= 1 And quexian(8, j) <10 Then
wy_wy = -1500 + 166.7
br_br = 5.5556
ElseIf quexian(8, j) >= 10 And quexian(8, j) <100 Then
wy_wy = -3000 + 166.7
br_br = 0.5555
ElseIf quexian(8, j) >= 100 And quexian(8, j) <1000 Then
wy_wy = -4500 + 166.7
br_br = 0.055555
End If
Picture1.Line (j * 5 + 500, quexian(8, j) * br_br * -30 + wy_wy + 3395 + 3000)-(j * 5 + 500, quexian(8, j) * br_br * -30 + wy_wy + 3405 + 3000), QBColor(11), BF
Next j
cmdExit.SetFocus
End Sub
以上代码需根据你实际处理数据情况修改,祝你成功!
欢迎分享，转载请注明来源：内存溢出
微信扫一扫
支付宝扫一扫
评论列表（0条）