跪求VB 作串口实时数据采集曲线

[压力火锅]

各位大侠：
小弟现在需在VB串口上位机加入将串口采集回来的数据以历史曲线显示的功能，能发个例子程序给我么，或告诉我怎么做！以下是小弟在论坛上看到的，有些不懂，不知道哪个死picture控件。各位大侠求助啊
实时曲线左移函数，定义在模块中

 Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
 
'建立一个类，作为画实时曲线
 Option Explicit
 
Public pCurveNUM                        As Integer
 Public pCurveName                       As String
 Public pCurveMax                        As Double
 Public pCurvemin                        As Double
 
Private pricCurve                       As PictureBox
 Private priCurvePoint(6)                As Integer
 Private priCurveData(6)                 As Double
 Private priDrawY0(6)                    As Double
 Private priDrawY1(6)                    As Double
 Private priDrawNMinute                  As Integer
 Private priDrawTMinute                  As Integer
 
Private WithEvents priTimerDraw         As Timer
 
Public Property Let ltDrawTimer(ByRef lTimer As Timer)
     
     Set priTimerDraw = lTimer
     
 End Property
 
Public Property Let ltGiveCurveData(ByVal lDataPoint As Variant)
     Dim i%
     For i = 1 To pCurveNUM
         priCurvePoint(i) = CInt(lDataPoint(i))
     Next
 End Property
 
Public Property Let ltGetPicture(ByRef lDrawPicBox As PictureBox)
      Set pricCurve = lDrawPicBox
 End Property
 


Private Sub sDrawTheRealTimeCurve()
 
    Dim ypixels, xpixels, i%
     Dim ShowMode As Long, ii As Long, tm As String, hBmp As Long
     pricCurve.DrawWidth = 1
     hBmp = pricCurve.hDC
     ShowMode = &HCC0020
     ii = BitBlt(hBmp, 0, 0, pricCurve.ScaleWidth - 1, pricCurve.ScaleHeight - 1, hBmp, 1, 0, ShowMode)
     Dim T As Integer
     T = Minute(Now())
     priDrawNMinute = T
     If priDrawNMinute > priDrawTMinute Then
         pricCurve.CurrentX = pricCurve.ScaleWidth - 19
         pricCurve.CurrentY = pricCurve.ScaleHeight - 11
         pricCurve.Print priDrawNMinute
     End If
     priDrawTMinute = priDrawNMinute
     pricCurve.ScaleMode = vbPixels
     ypixels = pricCurve.ScaleHeight - 1
     xpixels = pricCurve.ScaleWidth - 1
     
     'For 1 to 6 curves
     If pCurveNUM > 6 Or pCurveNUM < 1 Then pCurveNUM = 1
     For i = 1 To pCurveNUM
         priDrawY1(i) = CInt(ypixels - (priCurveData(i) - pCurvemin) / (pCurveMax - pCurvemin) * ypixels)
         If priDrawY1(i) = priDrawY0(i) Then priDrawY1(i) = priDrawY1(i) + 1
     Next
     pricCurve.Line (xpixels - 1, priDrawY0(1))-(xpixels - 1, priDrawY1(1)), vbRed
     If pCurveNUM > 1 Then pricCurve.Line (xpixels - 1, priDrawY0(2))-(xpixels - 1, priDrawY1(2)), vbWhite
     If pCurveNUM > 2 Then pricCurve.Line (xpixels - 1, priDrawY0(3))-(xpixels - 1, priDrawY1(3)), vbGreen
 '    If pCurveNUM > 3 Then pricCurve.Line (xpixels - 1, priDrawY0(4))-(xpixels - 1, priDrawY1(4)), spColor(3).FillColor
 '    If pCurveNUM > 4 Then pricCurve.Line (xpixels - 1, priDrawY0(5))-(xpixels - 1, priDrawY1(5)), spColor(4).FillColor
 '    If pCurveNUM > 5 Then pricCurve.Line (xpixels - 1, priDrawY0(6))-(xpixels - 1, priDrawY1(6)), spColor(5).FillColor
     For i = 1 To 6
         priDrawY0(i) = priDrawY1(i)
     Next
     
 End Sub
 
Public Sub clsInit()
 
    Dim i%
     
     For i = 1 To 6
         priDrawY0(i) = pricCurve.Height
         priDrawY1(i) = pricCurve.Height
     Next
 
    priTimerDraw.Interval = 1000
     priTimerDraw.Enabled = True
 End Sub
 
Private Sub priTimerDraw_Timer()
 
    Dim i%
     For i = 1 To pCurveNUM
         priCurveData(i) = gRealTimeData(priCurvePoint(i))
     Next
     Call sDrawTheRealTimeCurve
     
 End Sub

[qq_32816639]

Dim j As Integer
Dim i As Integer
Dim tem As Variant
Dim cnt As Integer
Dim saved As Integer
Dim darwed As Integer
Dim csbuf(155) As Variant
Dim zqlsbuf(155) As Variant
Dim yqlsbuf(155) As Variant
Dim zhlsbuf(155) As Variant
Dim yhlsbuf(155) As Variant
Dim hylbuf(155) As Variant
Dim zdjl(2) As Variant
Dim cstmp As Variant
Dim zctmp As Variant
Dim a As Integer
Dim b As String
Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)


Private Sub Check2_Click() '显示实际采集电流值曲线图

picture1show               '显示电流曲线图表
Picture1.DrawWidth = 1
j = 0
    For i = 0 To 900 Step 20
    Picture1.Line (i, csbuf(j) * 10)-(i + 20, csbuf(j + 1) * 10), vbGreen
    Sleep 1000
    
    j = j + 1
    Next i

End Sub

Private Sub Command2_Click(Index As Integer)


MSComm1.Output = "FF001160000C4"
  Sleep 300
MSComm1.Output = "FF00111FF"
  Sleep 300
MSComm1.Output = "FF0011605DCF0"
  Sleep 300
MSComm1.Output = "1000123D7"
picture1show               '显示电流曲线图表
Picture1.DrawWidth = 1
For i = 0 To 900 Step 20
   
    Picture1.Line (i, Text1.Text)-(i + 20, Text1.Text), vbGreen
    Sleep 1000
    
    j = j + 1
    Next i

MSComm1.Output = "FF0011603F8E5"
For d = 0 To 10
MSComm1.Output = "1000123D7"
d = d + 1
'需要延时500ms
Next d

MSComm1.Output = "FF0011280"
For e = 0 To 10
MSComm1.Output = "1000123D7"
e = e + 1
'需要延时500ms
Next e
End Sub

Private Sub Command4_Click()
On Error Resume Next
 If Shape1.FillColor = &H4000& Then  '如果没有启动，按下此按键，代表用户想启动
    MSComm1.CommPort = Combo1.ListIndex + 1
    MSComm1.Settings = "38400,n,8,1"        '设置波特率
    MSComm1.InputLen = 0
    MSComm1.InBufferSize = 1024             '设置缓冲区接收字节数
    MSComm1.OutBufferSize = 1024            '设置缓冲区发送字节数
    MSComm1.RThreshold = 1                  '设置接收1个字节就产生OnComm事件
    MSComm1.InBufferCount = 0               '清空输入缓冲区
    MSComm1.OutBufferCount = 0              '清空输出缓冲区
    MSComm1.SThreshold = 0
    MSComm1.RTSEnable = True                '接收数据使能
    MSComm1.InputMode = comInputModeText    '以字符串方式发送与接收
    MSComm1.InputLen = 0
    MSComm1.Handshaking = comNone '无握手协议
    MSComm1.PortOpen = True
    If Err Then
   ' MSComm1.PortOpen = False
    MsgBox "通讯端口选择错误！" + vbCrLf + "正确的串口号在这里看：" + vbCrLf + "桌面->我的电脑->属性->硬件->设备管理器->端口->COM"
    Else
    Shape1.FillColor = &HFF00& '把启动指示灯打开
    Command4.Caption = "关闭"
    Combo1.Enabled = False
    End If
    
    
 Else '如果启动了，按下此按键，代表用户想关闭
  
  MSComm1.PortOpen = False '关闭串口
  Shape1.FillColor = &H4000& '关闭启动指示灯
  Command4.Caption = "开启"
  Combo1.Enabled = True
  
 End If

End Sub

Private Sub Form_Load()
   Call InitRs232
   Call picture1show
   Combo1.Text = "COM1"
End Sub
Sub InitRs232() '初始化串口副程序
 '  On Error Resume Next
 '  MSComm1.CommPort = Combo1.ListIndex + 1 '设置com端口
 '  If MSComm1.PortOpen Then MSComm1.PortOpen = False '如果串口为打开状态则关闭它
  ' With MSComm1 '宣告MsComm控件的结构体
    '  .Settings = "38400,n,8,1" '设定通讯协议 9600波特率,无奇偶校验,8位数据,一个停止位
    '   .InBufferSize = 1024 '设置缓冲区接收数据为1字节
    '  .OutBufferSize = 1024
    '  .RThreshold = 1 '设置接收1个字节就产生OnComm事件
    '  .InBufferCount = 0 '清空缓冲区
    '  .OutBufferCount = 0
    '  .SThreshold = 0
    '  .RTSEnable = True
    '  .InputMode = comInputModeText
    ' .InputLen = 0
     
    ' End With
  
    ' Text1 = ""
End Sub
Private Sub Command1_Click(Index As Integer)
         
          Select Case Index
          Case 0
             MSComm1.Output = "1000100D2"
          Case 1
            MSComm1.Output = "@?WHERE" & vbCrLf
          Case 2
         MSComm1.Output = "@READ PGM" & vbCrLf
        End Select
        End Sub
  Private Sub MSComm1_OnComm()
  Dim bytInput() As Byte
  Dim intInputLen As Integer
  Dim teststring As String
    
  Select Case MSComm1.CommEvent
    Case comEvReceive
      
        MSComm1.InputMode = 0                    '0：文本方式，1：二进制方式
            
      intInputLen = MSComm1.InBufferCount
      bytInput = MSComm1.Input
            
     
      teststring = bytInput
        Text1.Text = teststring

teststring = ""

Dim b As String
Dim HexA As String
b = Mid(teststring, 9, 4)
HexA = b

Text1.Text = Val("&H" & HexA)
  End Select
  End Sub
Private Sub Form_Unload(Cancel As Integer)
    If MsgBox("确定要退出程序吗？", vbYesNo, "提示") = vbNo Then Cancel = True
    MSComm1.PortOpen = False
End Sub
'横坐标范围都是0~900，表示0~40s,5S间隔显示曲线，一共有75个点（900/12=75,12个像素点表示间隔5S）
'纵坐标范围0~900，表示0~2A，45个像素表示1mA
Sub picture1show()
 cnt = 0
 darwed = 0 '标志还没有画曲线
 Picture1.Cls
 Picture1.Scale (-100, 1100)-(1100, -100) '定义Picture1的坐标范围
 Picture1.DrawWidth = 2 '定义线宽
 
  
 Picture1.Line (0, 0)-(1000, 0), vbWhite '绘制横坐标线
 Picture1.Line (0, 0)-(0, 1000), vbWhite   '绘制纵坐标线
 
 
 Picture1.Line (0, 1000)-(-5, 980), vbWhite '绘制纵坐标箭头
 Picture1.Line -(5, 980), vbWhite
 Picture1.Line -(0, 1000), vbWhite
 
 Picture1.Line (1000, 0)-(990, -10), vbWhite  '绘制横坐标箭头
 Picture1.Line -(990, 10), vbWhite
 Picture1.Line -(1000, 0), vbWhite
 '绘制纵坐标间隔（间隔0.1mA）
 For i = 45 To 900 Step 45
 Picture1.Line (0, i)-(-10, i), vbWhite
 Next i
 '绘制横坐标间隔（间隔时间5s）
 For i = 100 To 900 Step 100
 Picture1.Line (i, 0)-(i, -20), vbWhite
 Next i
 '绘制网格
  Picture1.DrawWidth = 1
  For i = 100 To 900 Step 100
  Picture1.Line (i, 5)-(i, 900), RGB(0, 0, 99)
  Next i

  For i = 45 To 900 Step 45
  Picture1.Line (5, i)-(900, i), RGB(0, 0, 99)
  Next i
 
 '显示图表名称
 Picture1.ForeColor = vbRed
 Picture1.FontSize = 12
 Picture1.CurrentX = 350
 Picture1.CurrentY = 1050
 Picture1.Print "电流实时采集曲线"
 
 '显示横纵坐标名称
 Picture1.FontSize = 12
 Picture1.DrawWidth = 2
 Picture1.ForeColor = RGB(153, 255, 255)
 Picture1.CurrentX = 1020
 Picture1.CurrentY = 0
 Picture1.Print "时间:S"
 Picture1.CurrentX = -70
 Picture1.CurrentY = 1050
 Picture1.Print "电流:A"
 '显示纵坐标刻度值
 Dim j As Variant
 Picture1.FontSize = 10
 Picture1.DrawWidth = 1
 Picture1.ForeColor = vbGreen
 For j = 45 To 900 Step 45
 Picture1.CurrentX = -50
 Picture1.CurrentY = j + 15
 Picture1.Print Format(j / 450, "0.0")
 Next j
 

 '显示横坐标刻度值
 Picture1.FontSize = 10
 Picture1.DrawWidth = 1
 Picture1.ForeColor = vbGreen
 For j = 100 To 900 Step 100
 Picture1.CurrentX = j - 10
 Picture1.CurrentY = -35
 Picture1.Print Format(Trim(Str(j / 20)), 0)
 Next j
 
 '显示曲线颜色注释
 Picture1.FontSize = 9
 Picture1.DrawWidth = 2
 Picture1.ForeColor = vbWhite
 Picture1.CurrentX = 950
 Picture1.CurrentY = 1000
 Picture1.Print "工作设定"
 Picture1.Line (1040, 990)-(1090, 990), vbWhite
 
 
 Picture1.ForeColor = vbGreen
 Picture1.CurrentX = 950
 Picture1.CurrentY = 950
 Picture1.Print "实际采集"
 Picture1.Line (1040, 940)-(1090, 940), vbGreen
 

End Sub

Private Sub 新建_Click()
 If darwed = 1 And saved = 0 Then '如果已经画了曲线还没有保存
  If MsgBox("刚测试的曲线图未保存！您确定要新建吗？", vbQuestion + vbYesNo) = vbNo Then
  Else
   Call picture1show
  
  End If
 Else
 Call picture1show
 End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
End
End Sub

[赵4老师]