用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
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