VB画实时数据曲线

2024-12-21 14:24:35
推荐回答(1个)
回答1:

看下这个例子能否对你有帮助?
两个picturebox,四个optionbutton,两个commandbutton,一个HScroll1,max=10,其中一个picturebox中载入一副带有网格线的图片,做为背景用,(运行时这个picturebox看不见)
optionbutton的标题是rnd,sin,x^2,pulse.

Option Explicit
Private 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)
Private Const PS_SOLID& = 0 '实线
Private Const SRCCOPY& = &HCC0020
Private Declare Function DeleteObject& Lib "gdi32 " (ByVal hObject As Long)
Private Declare Function SelectObject& Lib "gdi32 " (ByVal hDC As Long, ByVal hObject As Long)
Private Declare Function CreatePen& Lib "gdi32 " (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long)
Private Declare Function Rectangle& Lib "gdi32 " (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
Private Declare Function MoveToEx& Lib "gdi32 " (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal lpPoint As Long)
Private Declare Function LineTo& Lib "gdi32 " (ByVal hDC As Long, ByVal x As Long, ByVal y As Long)
Private Declare Sub Sleep Lib "kernel32 " (ByVal dwMilliseconds As Long)
Private dX As Long
Private dy As Long
Private cuX As Long
Private cuCopyX As Long
Private picHeigth As Integer
Private picWidth
Private isGrap As Integer
Private MyTimeEnabld As Boolean
Private wait As Integer

Private Sub Command1_Click()
End
End Sub

Private Sub Command2_Click()
isStop = Not isStop
End Sub

Private Sub Command4_Click()
If Command4.Caption = "Start " Then
Command4.Caption = "Stop "
Else
Command4.Caption = "Start "
End If
If MyTimeEnabld = False Then
MyTimeEnabld = True
MyTimer
Else
MyTimeEnabld = False
End If
End Sub

Private Sub Form_Load()
Height = 3300: Width = 5475
Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
setValue
isGrap = 1
HScroll1.Value = 5

End Sub
Sub setValue()
Dim dl&

form1.ScaleMode = vbPixels
Picture1.ScaleMode = vbPixels
Picture2.ScaleMode = vbPixels
Picture1.AutoRedraw = True
Picture2.AutoRedraw = False

picHeigth = Picture2.Height
picWidth = Picture2.Width - 5
dy = Picture2.Height \ 2
dX = picWidth
cuCopyX = 0
dl& = MoveToEx(Picture1.hDC, dX, dy, 0&)
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub HScroll1_Change()
wait = HScroll1.Value
Label1.Caption = HScroll1.Value
End Sub
Private Sub Option1_Click(Index As Integer)
Picture1.Cls
setValue
isGrap = Index
End Sub
Private Sub MyTimer()
Do
Select Case isGrap
Case 0
Grap MyRnd()
Case 1
Grap MySin()
Case 2
Grap Xx()
Case 3
Grap Pulse()
End Select
Sleep wait
DoEvents
If MyTimeEnabld = False Then
Exit Do
End If
Loop
End Sub

Sub Grap(cuY As Long)
Dim dl&
Dim pen&, oldpen&
If cuY < 0 Then cuY = 0
If cuY > picHeigth Then cuY = picHeigth
cuX = dX + 1
cuCopyX = cuCopyX + 1
If cuCopyX > picWidth Then
dX = picWidth
cuX = dX + 1
cuCopyX = 1
Picture1.Cls
dl& = MoveToEx(Picture1.hDC, dX, dy, 0&)
dl& = BitBlt(Picture1.hDC, 0, 0, picWidth, picHeigth, Picture2.hDC, 0, 0, SRCCOPY)
End If

pen& = CreatePen(PS_SOLID, 1, RGB(255, 0, 0))
oldpen& = SelectObject(Picture1.hDC, pen&)
dl& = LineTo(Picture1.hDC, cuX, cuY)
dl& = SelectObject(Picture1.hDC, oldpen&)
dl& = DeleteObject(pen&)
dl& = BitBlt(Picture2.hDC, 0, 0, picWidth, picHeigth, Picture1.hDC, cuCopyX, 0, SRCCOPY)
dy = cuY: dX = dX + 1
If dy > 200 Then Stop
End Sub
'/////////////////////////////////
Function MyRnd() As Long
MyRnd = Rnd() * picHeigth
End Function
Function MySin()
Static Radim As Integer
MySin = Sin(Sin(Radim * 3.1426 / 180)) * picHeigth \ 2 + picHeigth \ 2
Radim = Radim + 4
If Radim > 360 Then Radim = 0
End Function
Function Xx()
Static x As Integer
Xx = x * x / 50
x = x + 1
If x = 100 Then x = 0
End Function
Function Pulse()
Static x As Integer
Static y As Integer
If x < 10 Then
y = y + 1
Pulse = 25
If y > 50 Then
x = 20
End If
Else
y = y - 1
Pulse = 125
If y < 0 Then
x = 0
End If
End If
End Function