| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1358 人关注过本帖
标题:绘制图表问题(实时绘图)
只看楼主 加入收藏
yalewang
Rank: 2
等 级:论坛游民
帖 子:125
专家分:35
注 册:2010-4-15
结帖率:94.74%
收藏
已结贴  问题点数:20 回复次数:4 
绘制图表问题(实时绘图)
本人想绘制一个图表,学了一段时间VB还是觉得无从下手,因此求教高手帮忙写一下,

这样可以帮助我在实例中学习和提高。谢谢

图表问题概况:

1、从.CSV文件中读取数据,存入数组(可以只读后50个数据),用来画图,该CSV文件由另一设备实时写入,有时一秒内会写入好几次。希望每有一次数据写入,VB程序读取一次(可否通过文件长度进行判断读取?)。

..CSV数据格式如下:

2010-3-16 5:28:35;1.36847000
2010-3-16 5:28:35;1.36849500
2010-3-16 5:28:36;1.36850500
2010-3-16 5:28:47;1.36848500
2010-3-16 5:28:47;1.36847000
2010-3-16 5:28:48;1.36846500
2010-3-16 5:28:48;1.36847000
2010-3-16 5:28:50;1.36853000
2010-3-16 5:28:50;1.36854000
2010-3-16 5:29:0;1.36854500


是由日期+时间+分号+数据组成。写入.CSV文件时是以字符串数据格式写入的。

2、画图时以时间为横轴,1秒为基本单位

3、图形画到最右边时,每增加一次图像点,图形整体向左移一个单位(把最左边的挤掉),(类似股票行情方式),或用其他方式实现,保证图像与数据实时同步,不超屏。

如能赐教,不胜感激
搜索更多相关主题的帖子: 图表 实时 绘制 绘图 
2010-04-15 16:26
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:20 
坐标实在是太小了.如果有一个值是0 的话,格子根本看不到.

BAS 文件代码
程序代码:
Option Explicit

Public Type 数据结构类型
    时间 As DateAs Double
    X As Long       '屏幕提示用的
    Y As Long
End Type

Public 数据(1 To 50) As 数据结构类型
Public Max值 As Double
Public Min值 As Double
Public 高间格 As Long, 宽间格 As Long

Public Const 坐标颜色 = 0
Public Const 网格颜色 = 1
Public Const 折线颜色 = 2
Public Const 标注颜色 = 3


Public Sub ADD数据(cs1 As String, cs2 As String)
Dim i As Long
If IsDate(cs1) And IsNumeric(cs2) Then
    For i = 2 To 50
        数据(i - 1).时间 = 数据(i).时间
        数据(i - 1).值 = 数据(i).值
        '数据(i - 1).X = 数据(i).X
        '数据(i - 1).Y = 数据(i).Y
    Next i
    数据(50).时间 = cs1
    数据(50).值 = cs2
End If
    'X Y需要重新计算,所以不需要移动
End Sub

Public Sub MaxMin值()       '找出最大值,最小值
Dim i As Long
Max值 = 数据(1).值
Min值 = 数据(1).值
For i = 2 To 50
    If Max值 < 数据(i).值 Then
        Max值 = 数据(i).值
    End If
    If Min值 > 数据(i).值 Then
        Min值 = 数据(i).值
    End If
Next i
End Sub

Public Sub Cls数据()
Dim i As Long
For i = 1 To 50
    数据(i).值 = 0
    数据(i).时间 = #12:00:00 AM#
Next i

End Sub

Public Sub 读数据(cs As String)

Dim fr As Long
fr = FreeFile

Dim d As String
Dim fj() As String
Dim j As String

Open cs For Input Access Read As #fr
    Do While Not EOF(fr)
        Line Input #fr, j
        If InStr(1, j, ";") > 0 Then
            fj = Split(j, ";")
            If d <> fj(0) Then
                d = fj(0)
                Call ADD数据(fj(0), fj(1))
            End If
        End If
    Loop

Close fr
End Sub


Public Sub 绘折线图(cs As PictureBox)

Dim i As Long, 间格 As Double
Dim 总高 As Long
Dim 最低格 As Double

With cs

Call MaxMin值           '找出最大值,最小值
If Min值 = 0 Then
    间格 = (Max值) / 11      '分为10格,上下各空一格
    最低格 = 0
Else
    间格 = (Max值 - Min值) / 10     '分为10格
    最低格 = Min值 - 间格
End If

总高 = .ScaleHeight - 200
高间格 = (总高) / 12      '上下各留一格
宽间格 = (.ScaleWidth - 600) / 51       '右边留一格

.Cls      '清屏

'画坐标
Dim x1 As Long, X2 As Long, y1 As Long, y2 As Long

y1 = .ScaleHeight - 200
x1 = .ScaleWidth - 200

cs.Line (600, 0)-(600, y1), 坐标颜色
cs.Line (600, y1)-(.ScaleWidth, y1), 坐标颜色

'画坐标网络
    .ForeColor = 标注颜色
    .CurrentX = 0
    .CurrentY = y1 - 90
    cs.Print Round(最低格, 3)
For i = 1 To 11
    cs.Line (600, y1 - i * 高间格)-(.ScaleWidth, y1 - i * 高间格), 网格颜色
    .CurrentX = 0
    .CurrentY = y1 - i * 高间格 - 90
    cs.Print Round(Min值 + i * 间格, 3)
Next i

For i = 1 To 50
    cs.Line (600 + i * 宽间格, 0)-(600 + i * 宽间格, y1), 网格颜色
    .CurrentX = 600 + i * 宽间格 - 150
    .CurrentY = y1 + 30
    cs.Print i
Next i

'画折线图
    数据(1).Y = y1 - ((数据(1).值 - 最低格) / (Max值 - 最低格)) * 总高
    数据(1).X = 600 + 宽间格
    cs.Circle (数据(1).X, 数据(1).Y), 30, 折线颜色
For i = 2 To 50
    数据(i).Y = y1 - ((数据(i).值 - 最低格) / (Max值 - 最低格)) * 总高
    数据(i).X = 600 + (i) * 宽间格
    cs.Circle (数据(i).X, 数据(i).Y), 30, 折线颜色
    cs.Line (数据(i - 1).X, 数据(i - 1).Y)-(数据(i).X, 数据(i).Y)
Next i

End With
End Sub

窗体代码

程序代码:
Option Explicit

Private Sub Command1_Click()
'测试按钮 ,定时器里的代码与此相同
    Call Cls数据                    '清掉前面的代码
    Call 读数据("333.txt")          '打开文件,读数据
    Call 绘折线图(Picture1)         '绘制折线图
'    Stop
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'显示提示
Dim i As Long

'只判断左右移动,不判断上下
If 宽间格 > 0 Then
    i = (X - 600) / 宽间格
    If i > 0 And i < 51 Then
        '提示格式是: 编号,时间 ,下一行,值
        Label1.Caption = i & " " & 数据(i).时间 & vbCrLf & 数据(i).值
        Label1.Move X, Y - Label1.Height - 15
        Label1.Visible = True
    Else
        Label1.Visible = False
    End If
Else
    Label1.Visible = False
End If
End Sub


窗体控件,
一个 Picture1 要求大一些,因为程序没有写错误处理 ,设置自动重绘开
在 Picture1 放一个 Label1 ,设置自动大小,3D=falsh, 边框=true
一个 Command1 测试用的.

授人于鱼,不如授人于渔
早已停用QQ了
2010-04-18 11:24
yalewang
Rank: 2
等 级:论坛游民
帖 子:125
专家分:35
注 册:2010-4-15
收藏
得分:0 
回复 2楼 风吹过b
多谢大哥,
很详细,我会好好学习。
2010-04-19 12:34
yalewang
Rank: 2
等 级:论坛游民
帖 子:125
专家分:35
注 册:2010-4-15
收藏
得分:0 
回复 2楼 风吹过b
多谢版主老师,你的程序我试过了,测试运行的很好,我试着添加另外一条曲线来对比观察,可没有数据能读出来,不知什么原因?能否帮我看看。
两个文件数据格式一样,数值差别不大,可以画在同一图中,其中一个数据变化较快,另一个滞后。两文件都是通过其他设备实时写入的。
另外,如TIMER的INTERVAL设置的太小,比如10以下,会否程序还没运行完,下一个TIMER事件被触发,从而影响数据的读取?

Option Explicit

Private Type 数据结构类型
    时间 As Date
     As Double
    X As Double       '屏幕提示用的
    Y As Double
End Type

Dim 数据(1 To 50) As 数据结构类型
Dim data8(1 To 50) As 数据结构类型    '自己添加的
Dim Max值 As Double  
Dim Min值 As Double

Dim interdata0 As Double               '自己添加的存储新数据
Dim interdata8 As Double               '自己添加的存储新数据
Dim datagate0 As Boolean               '自己添加的用于判断数据更新
Dim datagate8 As Boolean               '自己添加的用于判断数据更新
Dim 高间格 As Double, 宽间格 As Double 'Long


Public Sub ADD数据(cs1 As String, cs2 As String)  ’我的程序没用这个过程
Dim i As Integer
If IsDate(cs1) And IsNumeric(cs2) Then
    For i = 2 To 50
       ' 数据(i - 1).时间 = 数据(i).时间
        数据(i - 1).值 = 数据(i).值
        '数据(i - 1).X = 数据(i).X
        '数据(i - 1).Y = 数据(i).Y
    Next i
    '数据(50).时间 = cs1
    数据(50).值 = cs2
End If
    'X Y需要重新计算,所以不需要移动
End Sub

Public Sub ADDdata()                '自己添加的过程用于将两组数据同步更新

Dim i As Integer
If datagate0 = True or datagate8=true Then   '有任一组数据更新则全部重算,无更新的那一组前推,如都没更新,则本过程无实际代码执行
    If datagate0 = True Then
      For i = 2 To 50
          数据(i - 1).值 = 数据(i).值
      Next i
      数据(50).值 = interdata0
     else
      For i = 2 To 50
          数据(i - 1).值 = 数据(i).值
      Next i
    数据(50).值 = 数据(50).值
    End If

    If datagate8 = True Then
      For i = 2 To 50
          data8(i - 1).值 = data8(i).值
      Next i
    data8(50).值 = interdata8
    Else
      For i = 2 To 50
          data8(i - 1).值 = data8(i).值
      Next i
      data8(50).值 = data8(50).值
    End If
  
   
End If
    datagate0 = False
    datagate8 = False
   
End Sub


Public Sub MaxMin值()       '找出最大值,最小值,添加在两组数中找
Dim i As Integer
Max值 = 1.5 '数据(1).值
Min值 = 1.1   '数据(1).值
For i = 2 To 50
    If Max值 < 数据(i).值 Then
        Max值 = 数据(i).值
    End If
    If Min值 > 数据(i).值 Then
        Min值 = 数据(i).值
    End If
Next i
For i = 2 To 50
   If Max值 < data8(i).值 Then
       Max值 = data8(i).值
   End If
    If Min值 > data8(i).值 Then
        Min值 = data8(i).值
    End If
Next i
End Sub

Public Sub Cls数据()
Dim i As Integer
For i = 1 To 50
    数据(i).值 = 0
    数据(i).时间 = #12:00:00 AM#
    data8(i).值 = 0
    data8(i).时间 = #12:00:00 AM#
Next i

End Sub

Public Sub 读数据(cs As String)

Dim fr As Integer
fr = FreeFile
Dim d As String
Dim dd As String    '自己添加的
Dim fj() As String
Dim j As String


Open cs For Input Access Read As #fr
    Do While Not EOF(fr)
        Line Input #fr, j
        If InStr(1, j, ";") > 0 Then
            fj = Split(j, ";")
            If d <> fj(0)   Or dd <> fj(1) then  '自己添加一个条件
                d = fj(0)
                dd = fj(1)
                interdata0 = fj(1)
                datagate0 = True
               
                'Call ADD数据(fj(0), fj(1))
              
            End If
        End If
    Loop

Close fr


End Sub
Public Sub readdata8(cs8 As String)   '自己添加的读取另一文件数据

Dim fr8 As Integer
fr8 = FreeFile
Dim d8 As String
Dim dd8 As String
Dim fj8() As String
Dim j8 As String

Open cs8 For Input Access Read As #fr8
    Do While Not EOF(fr8)
        Line Input #fr8, j8
        If InStr(1, j8, ";") > 0 Then
            fj8 = Split(j8, ";")
            If d8 <> fj8(0) Or dd8 <> fj8(1) then
                d8 = fj8(0)
                dd8 = fj8(1)
                interdata8 = fj8(1)
                datagate8 = True
                'Call ADD数据(fj(0), fj(1))
              
            End If
        End If
    Loop

Close fr8
End Sub


Public Sub 绘折线图(cs As PictureBox)

Dim i As Integer, 间格 As Double
Dim 总高 As Long
Dim 最低格 As Double

With cs

Call MaxMin值           '找出最大值,最小值
If Min值 = 0 Then
    间格 = (Max值) / 11      '分为10格,上下各空一格11
    最低格 = 0
Else
    间格 = (Max值 - Min值) / 10     '分为10格10
    最低格 = Min值 - 间格
End If

总高 = .ScaleHeight - 200
高间格 = (总高) / 12      '上下各留一格
宽间格 = (.ScaleWidth - 600) / 51       '右边留一格

.Cls      '清屏

'画坐标
Dim x1 As Long, X2 As Long, y1 As Long, y2 As Long

y1 = .ScaleHeight - 200
x1 = .ScaleWidth - 200

cs.Line (600, 0)-(600, y1), vbRed
cs.Line (600, y1)-(.ScaleWidth, y1), vbRed

'画坐标网络
    .ForeColor = RGB(100, 200, 150)
    .CurrentX = 0
    .CurrentY = y1 - 90
    cs.Print Round(最低格, 5)
For i = 1 To 11
    cs.Line (600, y1 - i * 高间格)-(.ScaleWidth, y1 - i * 高间格), vbGreen
    .CurrentX = 0
    .CurrentY = y1 - i * 高间格 - 90
    cs.Print Round(Min值 + i * 间格, 5)
Next i

For i = 1 To 50
    cs.Line (600 + i * 宽间格, 0)-(600 + i * 宽间格, y1), vbGreen
    .CurrentX = 600 + i * 宽间格 - 150
    .CurrentY = y1 + 30
    cs.Print i
Next i

'画折线图
    数据(1).Y = y1 - ((数据(1).值 - 最低格) / (Max值 - 最低格)) * 总高
    数据(1).X = 600 + 宽间格
    cs.Circle (数据(1).X, 数据(1).Y), 30, vbBlue
    data8(1).Y = y1 - ((data8(1).值 - 最低格) / (Max值 - 最低格)) * 总高
    data8(1).X = 600 + 宽间格
    cs.Circle (data8(1).X, data8(1).Y), 30, vbGreen
For i = 2 To 50
    数据(i).Y = y1 - ((数据(i).值 - 最低格) / (Max值 - 最低格)) * 总高
    数据(i).X = 600 + (i) * 宽间格
    cs.Circle (数据(i).X, 数据(i).Y), 30, vbBlue
    cs.Line (数据(i - 1).X, 数据(i - 1).Y)-(数据(i).X, 数据(i).Y)
    data8(i).Y = y1 - ((data8(i).值 - 最低格) / (Max值 - 最低格)) * 总高
    data8(i).X = 600 + (i) * 宽间格
    cs.Circle (data8(i).X, data8(i).Y), 30, vbGreen
    cs.Line (data8(i - 1).X, data8(i - 1).Y)-(data8(i).X, data8(i).Y)
Next i

End With
End Sub



Private Sub Timer1_Timer()


    Call Cls数据                    '清掉前面的代码
    Call 读数据("E:\333.CSV")         '打开第一个文件,读数据
    Call readdata8("E:\888.CSV")         '打开第二个文件,读数据
    Call ADDdata
    Call 绘折线图(Picture1)         '绘制折线图
'    Stop

End Sub
2010-05-14 19:17
nature365
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2012-6-4
收藏
得分:0 
回复 楼主 yalewang
学习了,
2012-06-04 21:21
快速回复:绘制图表问题(实时绘图)
数据加载中...
 
   



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

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