用VB开发工控软件(HMI)时，经常需要对工艺参数进行趋势曲线的显示，这通常需要使用控件来实现，自然有第三方提供的控件，但那是需要付费的，并且有的使用情况并不理想，自己开发的话又差强人意，这里提供一个实时曲线显示的程序，给大家以启发。通过对程序的修改，可以很方便的应用到实际工程中去。
首先建立一个名为DrawLine的类模块，代码如下：
CODE:
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控件，添加代码如下：
CODE:
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()可能造成的资源的浪费，便于在长期运行的工控程序中使用。
其实我有一个很好的办法可以解决，你在画面上做一个"picture"控件，大小可以和你的要求的画，然后"picture"的宽度以"time"控件来控制，当你的实时曲线达到你“picture”的右边时，用"time"开始控制。
实时曲线你可以这样做
CODE:
pictrue1.currentX=初始值X
pictrue1.currentY=初始值Y
X=time *picture/N
Y=现在来的信号
picture1.line -(x,y)
pictrue1.currentX=time *picture/N
pictrue1.currentY=现在来的信号
这样就可以以时间来实现实时曲线。
设为首页 
