各位大俠：
小弟現在需在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
uj5u.com熱心網友回復：
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
uj5u.com熱心網友回復：
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/68598.html
上一篇：菜鳥新手求各位大神助
下一篇：求助做出來紅包