用VB開發工控軟件(HMI)時，經常需要對工藝參數進行趨勢曲線的顯示，這通常需要使用控件來實現，自然有第三方提供的控件，但那是需要付費的，并且有的使用情況并不理想，自己開發的話又差強人意，這里提供一個實時曲線顯示的程序，給大家以啟發。通過對程序的修改，可以很方便的應用到實際工程中去。
首先建立一個名為DrawLine的類模塊，代碼如下：
Public HorzSplits As Long
Public VertSplits As Long
Public Max As Single
Private ValueArray() As Single '存放數據的數組
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 '劃線的類型：線或點
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) '默認值綠色
Else:
GridColor = GColor
End If
If IsMissing(MoveGrid) Then
MovingGrid = False '如果用戶未定MoveGrid值則默認為關。
Else:
MovingGrid = MoveGrid
End If
Set pBox = pB
'分配數組
ReDim ValueArray(pBoxWidth - 1)
StartPosition = pBoxWidth - 1
GridPosition = 0
End Function
Public Sub AddValue(value As Single)
Dim l As Long
'檢查InitDrawline是否被執行，失敗則退出
If pBox Is Nothing Then
Exit Sub
End If
'將數組所有值移動一位。
For l = 1 To pBoxWidth - 1
ValueArray(l - 1) = ValueArray(l)
Next
If Max <= 0 Then Max = 1
'把新的值添加到數組的最后一個元素。
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
'首先清除圖片，然后畫網格(如果有的話)，最后畫線。
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
'網格復位
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
然后在窗體中添加四個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 = 要劃線的picturebox
'lcolor = 線的顏色
'sgrid = 是否使用網格
'gcolor = [optional] 網格顏色 (默認值為綠色)
'movegrid = [optional] 網格是否移動 (默認值不移動)
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
運行后的效果如下圖示：
這一程序的優點是使用數組來實現數據的保存，避免了應用API方式使用Bitblt()可能造成的資源的浪費，便于在長期運行的工控程序中使用。（www.eengineerarea.com）
其實我有一個很好的辦法可以解決，你在畫面上做一個"picture"控件，大小可以和你的要求的畫，然后"picture"的寬度以"time"控件來控制，當你的實時曲線達到你“picture”的右邊時，用"time"開始控制。
實時曲線你可以這樣做
pictrue1.currentX=初始值X
pictrue1.currentY=初始值Y
X=time *picture/N
Y=現在來的信號
picture1.line -(x,y)
pictrue1.currentX=time *picture/N
pictrue1.currentY=現在來的信號
這樣就可以以時間來實現實時曲線。
