form1.frm

图形显示程序试验实时数据的存贮和曲线的回放图形显示程序试验实时数据的存贮和曲线的回放

Dim TimerAverageCount As Integer '用来显示画图横坐标的时间计数器
Dim TimerAverageCount2 As Integer '用来回放画图横坐标的时间计数器
Dim HSbak As Integer

'测径仪保存数据
Private Type CJYSaveData
   LineName As String * 50 '50个字节
   LineNum As String * 30 '30个字节
   data As Single '4个字节
   saveday As Date '8个字节
   savetime As Date '8个字节
End Type
Dim NowSaveData As CJYSaveData '实时保存的数据
Dim NowGetData As CJYSaveData '从文件中读取的数据

Dim NowSaveData2(1000) As CJYSaveData




Dim NowCount As Long
Dim LastCount As Long

'测试数据
Dim n As Single
Dim m As Integer

Private Sub Command1_Click()
PicScale Pic, SetValue, UpValue, DownValue

End Sub
'给新生成的文件中添加数据
Private Sub Command10_Click()
n = n + 0.1

NowCount = NowCount + 1
NowSaveData.data = 10.01 + n

NowSaveData.LineName = LineNameFolderX
NowSaveData.LineNum = LineNumFileX
NowSaveData.saveday = Date
NowSaveData.savetime = Time

Put #1, NowCount, NowSaveData
MsgBox "数据保存成功"
End Sub
'读出数据
Private Sub Command11_Click()
Dim data As Single
Dim LineNameX As String
Dim LineNumX As String
Dim saveday As Date
Dim savetime As Date

'从写好的文件中读出数据
ReadDataFromFile NowGetData, m

data = NowGetData.data
LineNameX = NowGetData.LineName
LineNumX = NowGetData.LineNum
saveday = NowGetData.saveday
savetime = NowGetData.savetime


Text4(0).Text = data
Text4(1).Text = LineNameX
Text4(2).Text = LineNumX
Text4(3).Text = saveday
Text4(4).Text = savetime
End Sub

Private Sub Command12_Click()
Form2.Show

End Sub

Private Sub Command13_Click()
m = 0

End Sub

Private Sub Command14_Click()
Timer2.Enabled = False

End Sub

Private Sub Command15_Click()
Timer3.Enabled = True
Pic.Cls

End Sub

Private Sub Command16_Click()
Timer3.Enabled = False

End Sub

Private Sub Command2_Click()

OpenNewFile NewCreatFile
MsgBox "打开新建的文件成功"

Timer2.Enabled = True
End Sub

Private Sub Command3_Click()
Timer1.Enabled = True

End Sub

Private Sub Command4_Click()
SetValue = Val(Text1.Text)

End Sub

Private Sub Command5_Click()
UpValue = Val(Text2.Text) + SetValue

End Sub

Private Sub Command6_Click()
DownValue = Text2.Text + SetValue

End Sub

Private Sub Command8_Click()
Pic.Line (Pic.ScaleLeft, Pic.ScaleHeight / 2)-(Pic.ScaleWidth, Pic.ScaleHeight / 2), vbWhite

End Sub
'打开新建的文件
Private Sub Command9_Click()
OpenNewFile NewCreatFile
MsgBox "打开新建的文件成功"

End Sub

Private Sub Form_Load()
Pic.ScaleMode = 3
'Pic.Line (Pic.ScaleLeft, Pic.ScaleHeight / 2)-(Pic.ScaleWidth, Pic.ScaleHeight / 2), vbWhite
HSbak = HS1.Value

End Sub

Private Sub DrawRealPoint(PicX As PictureBox, Shape1X As Shape, Shape2X As Shape, TimeCountX As Integer, SetValueX As Single, UpValueX As Single, DownValueX As Single, DataFromComX As Single)
Dim Up As Single
Dim Down As Single
Dim SubValue As Single
SubValue = DataFromComX - SetValueX
If SubValue >= 0 Then
Up = SubValue
    If Up >= UpValueX - SetValueX Then
         Shape1X.BackColor = &HFF&
        Else
         Shape1X.BackColor = &HFF00&
    End If
    
ElseIf SubValue <= 0 Then
Down = SubValue
    If Down <= DownValueX - SetValueX Then
        Shape2X.BackColor = &HFF&
        Else
        Shape2X.BackColor = &HFF00&
    End If
Else
SubValue = SubValue
End If

Pic.PSet (TimeCountX, SubValue * 100), vbWhite


End Sub
Private Sub DrawRealPoint2(PicX As PictureBox, Shape1X As Shape, Shape2X As Shape, TimeCountX As Integer, SetValueX As Single, UpValueX As Single, DownValueX As Single, DataFromComX As Single, AverageValueLastX As Single)
Dim Up As Single
Dim Down As Single
Dim SubValue As Single
Dim subValueLast As Single
subValueLast = AverageValueLastX - SetValueX

SubValue = DataFromComX - SetValueX
If SubValue >= 0 Then
Up = SubValue
    If Up >= UpValueX - SetValueX Then
         Shape1X.BackColor = &HFF&
        Else
         Shape1X.BackColor = &HFF00&
    End If
    
ElseIf SubValue <= 0 Then
Down = SubValue
    If Down <= DownValueX - SetValueX Then
        Shape2X.BackColor = &HFF&
        Else
        Shape2X.BackColor = &HFF00&
    End If
Else
SubValue = SubValue
End If

'Pic.PSet (TimeCountX, SubValue * 100), vbWhite
If TimeCountX - 1 > 0 Then
PicX.Line (TimeCountX - 1, subValueLast * 100)-(TimeCountX, SubValue * 100), vbWhite
End If

End Sub

'画实时线段的子程序
Private Sub DrawRealLine(PicX As PictureBox, TimeCountX As Integer, AverageValueLastX As Single, AverageValueX As Single)
PicX.Line (TimeCountX - 1, AverageValueLastX)-(TimeCountX, AverageValueX), vbWhite
End Sub

Private Sub HS1_Change()
Pic.Width = Pic.Width + (HS1.Value - HSbak)
HSbak = HS1.Value

End Sub

Private Sub Timer1_Timer()
TimeCount = TimeCount + 1
DataFromCom = SetValue + 0.001 * TimeCount
Label3.Caption = DataFromCom




DrawRealPoint Pic, Shape1, Shape2, TimeCount, SetValue, UpValue, DownValue, DataFromCom

End Sub
Private Sub PicScale(PicX As PictureBox, SetValueX As Single, UpValueX As Single, DownValueX As Single)
Dim Up As Single
Dim Down As Single
Dim ScaleValue As Single
Dim PicXScaleHeight As Integer

Up = UpValueX - SetValueX
Down = SetValueX - SetValueX

If Up >= Down Then
    ScaleValue = Up
    ScaleValue = 2 * ScaleValue
    Else
    ScaleValue = Down
    ScaleValue = 2 * ScaleValue
End If

PicXScaleHeight = ScaleValue * 100

Pic.Scale (0, PicXScaleHeight)-(Pic.ScaleWidth, -PicXScaleHeight)

End Sub

'这个是用来画实时点的程序
Private Sub Timer2_Timer()
AverageValueLast = AverageValue '取出上次的AverageValue
AverageCount = AverageCount + 1 '对应1X6数组的计数器
Label7.Caption = AverageCount

TimeCount = TimeCount + 1 '模拟显示计数器
DataFromCom = SetValue + 0.001 * TimeCount '模拟显示从COM口中传过来的值
Label3.Caption = DataFromCom
TempValue(AverageCount - 1) = DataFromCom '给数组依次赋值
If AverageCount = 6 Then
TimerAverageCount = TimerAverageCount + 1 '用来显示画图横坐标的时间计数器
Label8.Caption = TimerAverageCount
'求数组6个值的平均值
AverageValue = Format((TempValue(0) + TempValue(1) + TempValue(2) + TempValue(3) + TempValue(4) + TempValue(5)) / 6, "###.###")
Label6.Caption = AverageValue

'n = n + 0.1

'NowCount = NowCount + 1
NowSaveData.data = AverageValue

NowSaveData.LineName = LineNameFolderX
NowSaveData.LineNum = LineNumFileX
NowSaveData.saveday = Date
NowSaveData.savetime = Time

Put #1, TimerAverageCount, NowSaveData
'MsgBox "数据保存成功"




'依据这个平均值和时间计数器来画图
DrawRealPoint2 Pic, Shape1, Shape2, TimerAverageCount, SetValue, UpValue, DownValue, AverageValue, AverageValueLast

'DrawRealLine Pic, TimerAverageCount, AverageValueLast, AverageValue


AverageCount = 0
End If

End Sub
Private Sub OpenNewFile(NewCreatFileX As String)
Open NewCreatFileX For Random As 1 Len = 100
End Sub
'往新生成的文件中写入数据
Private Sub SaveDataToFile(NowSaveDataX As CJYSaveData, NowCountX As Integer)
NowCountX = NowCountX + 1
Put #1, NowCountX, NowSaveData
MsgBox "数据保存成功"
End Sub
'从新生成的文件中读出数据
Private Sub ReadDataFromFile(NowGetDataX As CJYSaveData, NowCountX As Integer)
NowCountX = NowCountX + 1
Get #1, NowCountX, NowGetDataX
End Sub

'取得当前的测径仪的通讯数据值
Private Sub GetNowSaveData(NowSaveDataX As CJYSaveData, dataX As Single, LineNameX As String, LineNumX As String, SaveDayX As Date, SaveTimeX As Date)
NowSaveDataX.data = dataX
NowSaveDataX.LineName = LineNameX
NowSaveDataX.LineNum = LineNumX
NowSaveDataX.saveday = SaveDayX
NowSaveDataX.savetime = SaveTimeX
End Sub

Private Sub Timer3_Timer()
TimerAverageCount2 = TimerAverageCount2 + 1

AveragevalueLast2 = AverageValue2

Dim data As Single
Dim LineNameX As String
Dim LineNumX As String
Dim saveday As Date
Dim savetime As Date

'从写好的文件中读出数据
ReadDataFromFile NowGetData, m

data = NowGetData.data
LineNameX = NowGetData.LineName
LineNumX = NowGetData.LineNum
saveday = NowGetData.saveday
savetime = NowGetData.savetime

AverageValue2 = data
Text4(0).Text = data
Text4(1).Text = LineNameX
Text4(2).Text = LineNumX
Text4(3).Text = saveday
Text4(4).Text = savetime

DrawRealPoint2 Pic, Shape1, Shape2, TimerAverageCount2, SetValue, UpValue, DownValue, AverageValue2, AveragevalueLast2

End Sub