| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 2778 人关注过本帖
标题:画图 实时曲线
只看楼主 加入收藏
xi210602
Rank: 1
等 级:新手上路
帖 子:6
专家分:0
注 册:2007-12-27
收藏
 问题点数:0 回复次数:9 
画图 实时曲线
请问 怎样用vb画图 我是用mscomm控件从串口读出一个数据,每隔一秒取一次值。以时间为横轴,数值为纵轴,画一条实时曲线,用vb 怎样实现。请各位高手帮忙!!
搜索更多相关主题的帖子: 画图 曲线 实时 
2008-01-02 13:39
随风逐流
Rank: 16Rank: 16Rank: 16Rank: 16
来 自:passerby
等 级:版主
威 望:8
帖 子:4054
专家分:271
注 册:2007-6-13
收藏
得分:0 
先把数据拿来看看

[url=http://www./html/6/6694/]极道金丹[/url][url=http://www./html/2/2849/]九阴九阳[/url][url=http://www./html/2/2596/]凡人修仙传[/url]
2008-01-02 14:25
ioriliao
Rank: 7Rank: 7Rank: 7
来 自:广东
等 级:贵宾
威 望:32
帖 子:2829
专家分:647
注 册:2006-11-30
收藏
得分:0 
线由点组成,画点函数pset(x,y),vbcolorname
如以下假代码
x=time++
y=data++
PSet (x, y), vbColorName
2008-01-02 15:13
youjunpang
Rank: 1
等 级:新手上路
帖 子:2
专家分:0
注 册:2008-1-8
收藏
得分:0 
'下面的是clsCurve类模块
  '===========================================================
  Option Explicit
   
  Private m_hMemDC     As Long
  Private m_hBakDC     As Long
  Private m_hOutDC     As Long
  Private m_hOldMemBmp     As Long
  Private m_hOldBakBmp     As Long
  Private m_hOldMemPen     As Long
  Private m_hBrush     As Long
   
  Private m_nXUnitLen     As Long
  Private m_nYUnitLen     As Long
  Private m_nPrevY     As Long
  Private R     As RECT
      
  Public Sub SetView(ByVal hOutDC As Long, _
                                                  ByVal nWidth As Long, _
                                                  ByVal nHeight As Long, _
                                                  ByVal nXUnits As Long, _
                                                  ByVal nYUnits As Long)
            
          Dim hObject     As Long
          m_hOutDC = hOutDC
          R.Left = 0:       R.Top = 0
          R.Bottom = nHeight
          R.Right = nWidth
          m_nXUnitLen = nWidth \ nXUnits
          m_nYUnitLen = nHeight \ nYUnits
            
          m_hMemDC = CreateCompatibleDC(hOutDC)
          m_hBakDC = CreateCompatibleDC(hOutDC)
            
            
          hObject = CreateCompatibleBitmap(hOutDC, nWidth, nHeight)
          m_hOldMemBmp = SelectObject(m_hMemDC, hObject)
            
          hObject = CreateCompatibleBitmap(hOutDC, nWidth, nHeight)
          m_hOldBakBmp = SelectObject(m_hBakDC, hObject)
            
          hObject = CreatePen(0, 1, vbBlack)
          m_hOldMemPen = SelectObject(m_hMemDC, hObject)
            
          m_hBrush = CreateSolidBrush(vbWhite)
          FillRect m_hMemDC, R, m_hBrush
          BitBlt m_hOutDC, 0, 0, nWidth, nHeight, m_hMemDC, 0, 0, vbSrcCopy
            
  End Sub
   
   
  Public Sub DrawCurve(ByVal nY As Long)
            
          '保留原来的曲线
          Dim nWidth     As Long, nHeight       As Long
          nWidth = R.Right
          nHeight = R.Bottom
            
          BitBlt m_hBakDC, 0, 0, nWidth, nHeight, m_hMemDC, 0, 0, vbSrcCopy
          FillRect m_hMemDC, R, m_hBrush
          '向左退移1个单位
          BitBlt m_hMemDC, 0, 0, nWidth, nHeight, m_hBakDC, m_nXUnitLen, 0, vbSrcCopy
            
          '画新的曲线
          Dim PrevPoint     As POINTAPI
          nY = nHeight - CLng(nY * m_nYUnitLen)
          MoveToEx m_hMemDC, nWidth - m_nXUnitLen, m_nPrevY, PrevPoint
            
          LineTo m_hMemDC, nWidth - 1, nY
   
          m_nPrevY = nY
            
          '输出结果
   
          BitBlt m_hOutDC, 0, 0, nWidth, nHeight, m_hMemDC, 0, 0, vbSrcCopy
            
  End Sub
   
   
   
   
  Public Sub RedrawCurve()
          If m_hMemDC = 0 Then Exit Sub
          BitBlt m_hOutDC, 0, 0, R.Right, R.Bottom, m_hMemDC, 0, 0, vbSrcCopy
  End Sub
   
  Public Property Get hdc() As Long
          hdc = m_hMemDC
  End Property
   
   
  Private Sub Class_Terminate()
          Dim hMemUsedBmp     As Long, hBakUsedBmp       As Long
          Dim hMemUsedPen     As Long
            
          hMemUsedBmp = SelectObject(m_hMemDC, m_hOldMemBmp)
          hBakUsedBmp = SelectObject(m_hBakDC, m_hOldBakBmp)
          hMemUsedPen = SelectObject(m_hMemDC, m_hOldMemPen)
         
          DeleteDC m_hMemDC
          DeleteDC m_hBakDC
            
          DeleteObject hMemUsedBmp
          DeleteObject hBakUsedBmp
          DeleteObject hMemUsedPen
          DeleteObject m_hBrush
  End Sub

  '下面的是modGDI模块
  '===========================================================
  Option Explicit
  Public Type POINTAPI
                  x   As Long
                  y   As Long
  End Type
   
  Public Type RECT
                  Left   As Long
                  Top   As Long
                  Right   As Long
                  Bottom   As Long
  End Type
   
  Public Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
  Public Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
  Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  Public Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
  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
  Public Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
   
  '下面的是frmMain窗体,注意自己创建控件
  '===========================================================
  Option Explicit
  Dim CurveDrawer     As clsCurve
   
  Private Sub cmdDemo_Click()
          Dim nY     As Long
          CurveDrawer.SetView picOut.hdc, picOut.Width - 10, picOut.Height - 10, 50, 50
          Timer.Enabled = True
  End Sub
   
  Private Sub Form_Load()
          ScaleMode = 3
          Timer.Interval = 500
          Timer.Enabled = False
          Set CurveDrawer = New clsCurve
  End Sub
   
  Private Sub picOut_Paint()
          CurveDrawer.RedrawCurve
  End Sub
   
  Private Sub Timer_Timer()
          CurveDrawer.DrawCurve CLng(Rnd * 51)
  End Sub
2008-01-08 21:33
hpwangcheng
Rank: 1
等 级:新手上路
帖 子:32
专家分:0
注 册:2007-2-10
收藏
得分:0 
高手,看的不是太懂
2008-01-13 20:46
侯伟峰
Rank: 1
等 级:新手上路
帖 子:2
专家分:0
注 册:2008-1-27
收藏
得分:0 
研究一下这个BitBlt 就能处理这个问题了。
2008-01-28 09:24
尐妖
Rank: 2
来 自:广东省
等 级:新手上路
威 望:3
帖 子:120
专家分:0
注 册:2008-2-16
收藏
得分:0 
研究[bc05]

倣棄?.﹎徻sんì嬄種繲脫嗎╃┈
2008-02-27 19:49
fanxin_bme
Rank: 1
等 级:新手上路
帖 子:2
专家分:0
注 册:2008-2-29
收藏
得分:0 
我用了lineto函数后,为什么画出的只是点,不是线呢?
其中,voltage的值保持7600左右,如果没有变化的话,画出的就什么都没有.
为什么呢?

Option Explicit

Dim OutBuf(0 To 0) As Byte
Dim InBuf() As Byte
Dim CheckSum As String
Dim Voltage, Current As Integer

Dim CurveDrawer     As clsCurve

Private Sub Command1_Click()
    Dim nY     As Long
    CurveDrawer.SetView picOut.hdc, picOut.Width - 10, picOut.Height - 10, 790, 590
    Timer1.Enabled = True
End Sub
Private Sub picOut_Paint()
         CurveDrawer.RedrawCurve
End Sub

Private Sub Exit_Click()
    If MSComm1.PortOpen = True Then
        MSComm1.PortOpen = False
    End If

    Unload Form1
End
End Sub

Private Sub Form_Load()
'''''''''''''''''''''''''''''''''''''''''''''''
'
'''''''''''''''''''''''''''''''''''''''''''''''
picOut.Width = 12000
picOut.Height = 9000
ScaleMode = 3
Timer1.Interval = 100
Timer1.Enabled = False
Set CurveDrawer = New clsCurve


'''''''''''''''''''''''''''''''''''''''''''''''
'
'''''''''''''''''''''''''''''''''''''''''''''''
= 1                     '?è?¨Com1
MSComm1.Settings = "9600,n,8,1"         '9600?¨???????????é??8??????????1????????
MSComm1.InBufferSize = 40
MSComm1.OutBufferSize = 40
MSComm1.InputMode = 1
MSComm1.InputLen = 0
MSComm1.SThreshold = 0
MSComm1.InBufferCount = 0               '??????????????
MSComm1.OutBufferCount = 0              '????·?????????
'MSComm1.RThreshold = 1
     
On Error Resume Next
Err.Clear
If MSComm1.PortOpen = False Then
    MSComm1.PortOpen = True
   
    If Err Then
    MsgBox "?????¨?????§"
    Exit Sub
    End If

End If
End Sub

Sub TimeDelay(DT As Long)
Dim tt As Long

tt = GetTickCount()
Do
DoEvents
Loop Until GetTickCount - tt >= DT
End Sub

Private Sub Stop_Click()
CommandFlag = True
SendCommand = "STOP"
End Sub
Public Sub SEND_REC(BT As Byte, CNT As Integer)
        OutBuf(0) = CByte(BT)
        MSComm1.InBufferCount = 0
        MSComm1.Output = OutBuf
        TimeDelay (100)
        Do
        DoEvents
        Loop Until MSComm1.InBufferCount = CNT
        
        ReDim InBuf(CNT)
        InBuf = MSComm1.Input
        MSComm1.InBufferCount = 0
        
        If InBuf(0) <> OutBuf(0) Then
            MsgBox "ERROR COMMUNICATION"
        End If
End Sub

Private Sub Timer1_Timer()

Dim i As Integer
...
CurveDrawer.DrawCurve CLng(Voltage / 20)
picOut.Refresh

End Sub
2008-02-29 17:28
fanxin_bme
Rank: 1
等 级:新手上路
帖 子:2
专家分:0
注 册:2008-2-29
收藏
得分:0 
picture
attach the picture

untitled.JPG (64.93 KB)
图片附件: 游客没有浏览图片的权限,请 登录注册
2008-03-01 11:18
xuninghan911
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2008-7-3
收藏
得分:0 
啊,我也想问这个问题呢。。
2008-07-03 01:01
快速回复:画图 实时曲线
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.028202 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved