| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 682 人关注过本帖
标题:再次请教各位达人
只看楼主 加入收藏
姿式菲凡
该用户已被删除
收藏
已结贴  问题点数:20 回复次数:10 
再次请教各位达人
提示: 作者被禁止或删除 内容自动屏蔽
2010-04-29 12:31
姿式菲凡
该用户已被删除
收藏
得分:0 
提示: 作者被禁止或删除 内容自动屏蔽
2010-04-29 20:44
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:10 
请,上传工程.

其次,这个工程可以使用 到多深的内容:
自定义过程?
绘图?
类?
自定义控件?

授人于鱼,不如授人于渔
早已停用QQ了
2010-04-30 08:14
jiashie
Rank: 8Rank: 8
等 级:贵宾
威 望:10
帖 子:237
专家分:999
注 册:2009-4-30
收藏
得分:10 
检查select case 的几个分支中是否包含重复的区间?
2010-04-30 09:03
姿式菲凡
该用户已被删除
收藏
得分:0 
提示: 作者被禁止或删除 内容自动屏蔽
2010-04-30 09:26
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 

窗体代码, 使用 timer + 随机数来进行数据仿真
程序代码:
Option Explicit
Dim SB1 As Boolean
Dim Sb2 As Boolean
Dim Sb3 As Boolean
Dim 水位 As Double

Dim 目标水位 As Double

Dim 工作 As Boolean

Private Sub Command2_Click()
    工作 = Not 工作
   
    If 工作 Then
        Shape4.FillColor = vbGreen
    Else
        Shape4.FillColor = vbRed
    End If
   
   
End Sub

Private Sub Form_Load()
    工作 = False
    Shape4.FillColor = vbRed
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 - 左边距) / 宽间格
    If i > 0 And i < 51 Then
        '提示格式是: 编号,时间 ,下一行,值
        Label2.Caption = i & vbCrLf & 数据(i).时间 & vbCrLf & 数据(i).值
        Label2.Move X - Label1.Height, Y - Label1.Width
        Label2.Visible = True
    Else
        Label2.Visible = False
    End If
Else
    Label2.Visible = False
End If
End Sub


Private Sub Timer1_Timer()

Dim 速度 As Double

If 工作 Then

    速度 = Rnd()
   
    If Abs(水位 - 目标水位) < 0.5 Then
        目标水位 = Round(Rnd() * 11 + 3, 2)
    End If
   
    If 水位 > 目标水位 Then
        水位 = 水位 - 速度
    Else
        水位 = 水位 + 速度
    End If
    水位 = Round(水位, 2)
   
   
    If 水位 > 14 Then
        水位 = 14
    End If
    If 水位 < 3.5 Then
        水位 = 3.5
    End If
   
    Text1.Text = 水位
   
    Call ADD数据(Time, 水位)
    Call 绘折线图(Picture1)
   
    Call 检测

End If

End Sub

Private Sub 检测()
If 水位 < Val(Text2(0).Text) And 水位 > Val(Text3(0).Text) Then
    Shape1.FillColor = vbGreen
Else
    Shape1.FillColor = vbRed
End If

If 水位 < Val(Text2(1).Text) And 水位 > Val(Text3(1).Text) Then
    Shape2.FillColor = vbGreen
Else
    Shape2.FillColor = vbRed
End If

If 水位 < Val(Text2(2).Text) And 水位 > Val(Text3(2).Text) Then
    Shape3.FillColor = vbGreen
Else
    Shape3.FillColor = vbRed
End If
End Sub

模块代码,来源前面贴子里 折线图绘制,50格
程序代码:
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 网格颜色 = vbGreen
Public Const 折线颜色 = vbRed
Public Const 标注颜色 = 3
Public Const 左边距 = 400


Public Sub ADD数据(cs1 As String, cs2 As Double)
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
Max值 = 15
Min值 = 3
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值) / 12     '分为10格
    最低格 = Min值 '- 间格
End If

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

.Cls      '清屏

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

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

cs.Line (左边距, 0)-(左边距, y1), 坐标颜色
cs.Line (左边距, y1)-(.ScaleWidth, y1), 坐标颜色

'画坐标网络
    .ForeColor = 标注颜色
    .CurrentX = 0
    .CurrentY = y1 - 90
    cs.Print Round(最低格, 3)
For i = 1 To 11
    cs.Line (左边距, 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 (左边距 + i * 宽间格, 0)-(左边距 + i * 宽间格, y1), 网格颜色
    .CurrentX = 左边距 + i * 宽间格 - 150
    .CurrentY = y1 + 30
    cs.Print i
Next i

'画折线图
    数据(1).Y = y1 - ((数据(1).值 - 最低格) / (Max值 - 最低格)) * 总高
    数据(1).X = 左边距 + 宽间格
    cs.Circle (数据(1).X, 数据(1).Y), 30, 折线颜色
For i = 2 To 50
    数据(i).Y = y1 - ((数据(i).值 - 最低格) / (Max值 - 最低格)) * 总高
    数据(i).X = 左边距 + (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

水位.rar (3.81 KB)


授人于鱼,不如授人于渔
早已停用QQ了
2010-04-30 09:28
姿式菲凡
该用户已被删除
收藏
得分:0 
回复 3楼 风吹过b
提示: 作者被禁止或删除 内容自动屏蔽
2010-04-30 09:29
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
回7楼, 上传的文件错误,你只打包了 vbp 文件,这只是工程 标识文件,只能告诉VB ,工程引用了那些 OCX 、库 等, 还有包含哪些窗体文件,哪些模块,哪些类,以及工程的设置等

不包含工程的任何代码。

最后,你题目不全,所以我按我的理解画的一个。

授人于鱼,不如授人于渔
早已停用QQ了
2010-04-30 09:34
姿式菲凡
该用户已被删除
收藏
得分:0 
回复 8楼 风吹过b
提示: 作者被禁止或删除 内容自动屏蔽
2010-04-30 09:45
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
你打开的文件有问题,不能双击 form1 进行打开,而应该双击 工程1 进行打开。
如果你是双击form1 进行打开的,就会出现你刚这种情况。

add数据 还有几个函数,还有一些常量,是在 bas 文件里定义的,所以需要双击 工程1 那个文件打开。


授人于鱼,不如授人于渔
早已停用QQ了
2010-04-30 09:58
快速回复:再次请教各位达人
数据加载中...
 
   



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

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