用VB開(kāi)發(fā)工控軟件(HMI)時(shí)，經(jīng)常需要對(duì)工藝參數(shù)進(jìn)行趨勢(shì)曲線的顯示，這通常需要使用控件來(lái)實(shí)現(xiàn)，自然有第三方提供的控件，但那是需要付費(fèi)的，并且有的使用情況并不理想，自己開(kāi)發(fā)的話又差強(qiáng)人意，這里提供一個(gè)實(shí)時(shí)曲線顯示的程序，給大家以啟發(fā)。通過(guò)對(duì)程序的修改，可以很方便的應(yīng)用到實(shí)際工程中去。
首先建立一個(gè)名為DrawLine的類模塊，代碼如下：
Public HorzSplits As Long
Public VertSplits As Long
Public Max As Single
Private ValueArray() As Single '存放數(shù)據(jù)的數(shù)組
Private LineColor As Long
Private GridColor As Long
Private ShowGrid As Boolean
Private pBox As PictureBox
Private pBoxHeight As Long
Private pBoxWidth As Long
Private MovingGrid As Boolean
Private StartPosition As Long
Private GridPosition As Long
Public Enum DrawLineType
TYPE_LINE = 0
TYPE_POINT = 1
End Enum
Public LineType As DrawLineType '劃線的類型：線或點(diǎn)
Const const_tolerance = 0.0001 '誤差
Public Function InitDrawLine(pB As PictureBox, LColor As Long, SGrid As Boolean, Optional GColor As Variant, Optional MoveGrid As Variant)
pB.ScaleMode = vbPixels
LineColor = LColor
ShowGrid = SGrid
pBoxHeight = pB.ScaleHeight
pBoxWidth = pB.ScaleWidth
If IsMissing(GColor) Then
GridColor = RGB(0, 130, 0) '默認(rèn)值綠色
Else:
GridColor = GColor
End If
If IsMissing(MoveGrid) Then
MovingGrid = False '如果用戶未定MoveGrid值則默認(rèn)為關(guān)。
Else:
MovingGrid = MoveGrid
End If
Set pBox = pB
'分配數(shù)組
ReDim ValueArray(pBoxWidth - 1)
StartPosition = pBoxWidth - 1
GridPosition = 0
End Function
Public Sub AddValue(value As Single)
Dim l As Long
'檢查InitDrawline是否被執(zhí)行，失敗則退出
If pBox Is Nothing Then
Exit Sub
End If
'將數(shù)組所有值移動(dòng)一位。
For l = 1 To pBoxWidth - 1
ValueArray(l - 1) = ValueArray(l)
Next
If Max <= 0 Then Max = 1
'把新的值添加到數(shù)組的最后一個(gè)元素。
ValueArray(l - 1) = pBoxHeight - ((value / Max) * pBoxHeight)
If StartPosition >= 1 Then StartPosition = StartPosition - 1
GridPosition = GridPosition - 1
End Sub
Public Sub RePaint()
Dim x As Single
Dim y As Single
Dim l As Long
If pBox Is Nothing Then
Exit Sub
End If
'首先清除圖片，然后畫網(wǎng)格(如果有的話)，最后畫線。
pBox.Cls
If (ShowGrid) Then
pBox.ForeColor = GridColor
If (MovingGrid) Then
For x = GridPosition To pBoxWidth - 1 Step ((pBoxWidth - 1) / (VertSplits + 1)) - const_tolerance
pBox.Line (x, 0)-(x, pBoxHeight)
Next
Else:
For x = 0 To pBoxWidth - 1 Step ((pBoxWidth - 1) / (VertSplits + 1)) - const_tolerance
pBox.Line (x, 0)-(x, pBoxHeight)
Next
End If
For y = 0 To pBoxHeight - 1 Step ((pBoxHeight - 1) / (HorzSplits + 1)) - const_tolerance
pBox.Line (0, y)-(pBoxWidth, y)
Next
'網(wǎng)格復(fù)位
If GridPosition <= -Int((pBoxWidth - 1 / (HorzSplits + 1))) Then
GridPosition = 0
End If
End If
If StartPosition <= pBoxWidth - 1 Then
pBox.ForeColor = LineColor
Select Case DiagramType
Case TYPE_LINE
For l = StartPosition + 1 To pBoxWidth - 2
pBox.Line (l, ValueArray(l))-(l + 1, ValueArray(l + 1))
Next
Case TYPE_POINT
For l = StartPosition + 1 To pBoxWidth - 2
pBox.PSet (l + 1, ValueArray(l + 1))
Next
End Select
End If
End Sub
然后在窗體中添加四個(gè)picturebox控件，添加代碼如下：
Public LDraw1 As New DrawLine
Public LDraw2 As New DrawLine
Public PDraw1 As New DrawLine
Public PDraw2 As New DrawLine
Public tancounter As Single
Private Sub Command1_Click()
'.InitDrawLine picturebox, lcolor, sgrid, gcolor, movegrid
'picturebox = 要?jiǎng)澗€的picturebox
'lcolor = 線的顏色
'sgrid = 是否使用網(wǎng)格
'gcolor = [optional] 網(wǎng)格顏色 (默認(rèn)值為綠色)
'movegrid = [optional] 網(wǎng)格是否移動(dòng) (默認(rèn)值不移動(dòng))
With LDraw1
.InitDrawLine Picture_line, vbWhite, True
.Max = 10
.HorzSplits = 9
.VertSplits = 9
.LineType = TYPE_LINE
.RePaint
End With
With PDraw1
.InitDrawLine Picture_point, vbRed, True
.Max = 20
.HorzSplits = 9
.VertSplits = 9
.LineType = TYPE_POINT
.RePaint
End With
With LDraw2
.InitDrawLine Picture_line2, vbGreen, True, , True
.Max = 5
.HorzSplits = 9
.VertSplits = 9
.LineType = TYPE_LINE
.RePaint
End With
With PDraw2
.InitDrawLine Picture_point2, vbYellow, True, RGB(100, 100, 0), True
.Max = 10
.HorzSplits = 9
.VertSplits = 9
.LineType = TYPE_POINT
.RePaint
End With
End Sub
Private Sub Picture_line_Paint()
LDraw1.RePaint
End Sub
Private Sub Picture_line2_Click()
LDraw2.RePaint
End Sub
Private Sub Picture_point_Paint()
PDraw1.RePaint
End Sub
Private Sub Picture_point2_Click()
PDraw1.RePaint
End Sub
Private Sub Timer1_Timer()
Dim value As Single
tancounter = tancounter + 0.1
value = Sin(tancounter) + 2
LDraw1.AddValue value
LDraw2.AddValue value
PDraw1.AddValue value
PDraw2.AddValue value
LDraw1.RePaint
LDraw2.RePaint
PDraw1.RePaint
PDraw2.RePaint
End Sub
運(yùn)行后的效果如下圖示：
這一程序的優(yōu)點(diǎn)是使用數(shù)組來(lái)實(shí)現(xiàn)數(shù)據(jù)的保存，避免了應(yīng)用API方式使用Bitblt()可能造成的資源的浪費(fèi)，便于在長(zhǎng)期運(yùn)行的工控程序中使用。（www.eengineerarea.com）
其實(shí)我有一個(gè)很好的辦法可以解決，你在畫面上做一個(gè)"picture"控件，大小可以和你的要求的畫，然后"picture"的寬度以"time"控件來(lái)控制，當(dāng)你的實(shí)時(shí)曲線達(dá)到你“picture”的右邊時(shí)，用"time"開(kāi)始控制。
實(shí)時(shí)曲線你可以這樣做
pictrue1.currentX=初始值X
pictrue1.currentY=初始值Y
X=time *picture/N
Y=現(xiàn)在來(lái)的信號(hào)
picture1.line -(x,y)
pictrue1.currentX=time *picture/N
pictrue1.currentY=現(xiàn)在來(lái)的信號(hào)
這樣就可以以時(shí)間來(lái)實(shí)現(xiàn)實(shí)時(shí)曲線。
