frmtransient.frm
来自「用VB实现正弦波的采集和傅里叶变换。将时域信号变化为频域信号」· FRM 代码 · 共 423 行
FRM
423 行
VERSION 5.00
Begin VB.Form FrmTr
AutoRedraw = -1 'True
BackColor = &H00C0C0C0&
Caption = "双通道舜态信号示波器"
ClientHeight = 11010
ClientLeft = 60
ClientTop = 405
ClientWidth = 15240
FillColor = &H00E0E0E0&
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
PaletteMode = 1 'UseZOrder
ScaleHeight = 11411.17
ScaleMode = 0 'User
ScaleWidth = 15360
StartUpPosition = 2 'CenterScreen
WindowState = 2 'Maximized
Begin VB.Timer TmrSample
Enabled = 0 'False
Interval = 10
Left = 14640
Top = 6000
End
Begin VB.CommandButton CmdDel
Caption = "删 除"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 14280
TabIndex = 8
Top = 2520
Width = 855
End
Begin VB.CommandButton CmdSet
Caption = "设 置"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 14280
TabIndex = 7
Top = 4320
Width = 855
End
Begin VB.CommandButton CmdStop
Caption = "停 止"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 14280
TabIndex = 6
Top = 1680
Width = 855
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 100
Left = 14160
Top = 6000
End
Begin VB.PictureBox PicTime
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00404040&
BorderStyle = 0 'None
ForeColor = &H0000FFFF&
Height = 375
Left = 120
ScaleHeight = 375
ScaleWidth = 13935
TabIndex = 5
Top = 10200
Width = 13935
End
Begin VB.PictureBox PicAmp
AutoRedraw = -1 'True
BackColor = &H00404040&
BorderStyle = 0 'None
BeginProperty Font
Name = "Times New Roman"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000C000&
Height = 9735
Left = 120
ScaleHeight = 9735
ScaleWidth = 735
TabIndex = 4
Top = 480
Width = 735
End
Begin VB.PictureBox Pic
AutoRedraw = -1 'True
BackColor = &H00404040&
BorderStyle = 0 'None
ForeColor = &H0000C000&
Height = 9735
Left = 840
ScaleHeight = 9735
ScaleWidth = 13215
TabIndex = 2
Top = 482
Width = 13215
End
Begin VB.CommandButton cmdSample
Caption = "采 样"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 14280
TabIndex = 1
Top = 840
Width = 855
End
Begin VB.CommandButton CmdEnd
Cancel = -1 'True
Caption = "退出"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 14280
TabIndex = 0
Top = 9960
Width = 855
End
Begin VB.Label Lblnum
Height = 255
Left = 1080
TabIndex = 9
Top = 120
Width = 1815
End
Begin VB.Label LblFreq
Height = 255
Left = 6720
TabIndex = 3
Top = 120
Width = 1815
End
End
Attribute VB_Name = "FrmTr"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim dd1(40960) As Integer '采样结果存放
Dim dd0(40960) As Integer
Dim dd2(40960) As Integer
Private fr(10) As Integer '采样频率数组
Private fcode As Integer '频率码
'Private kf As Integer '采样频率号
Private ExitFlag As Boolean '终止标志
Private DelFlag As Boolean '删除标志
Private k As Integer
Private Sub CmdDel_Click()
DelFlag = True: k = k - 1
End Sub
Private Sub CmdEnd_Click()
'CloseUA300 (husb)
Unload FrmTr
End Sub
Private Sub CmdSet_Click()
FrmSet.Show 1
End Sub
Private Sub CmdStop_Click()
ExitFlag = True
End Sub
Private Sub Form_Activate()
LblFreq.Caption = "采样频率:" + Str$(fr(kf) \ 2) + "K Hz"
End Sub
Private Sub Form_Load()
kf = 2
fr(0) = 100 '100k
fr(1) = 50 ' 50k
fr(2) = 20 ' 20k
fr(3) = 10 ' 10k
fr(4) = 5 ' 5k
fr(5) = 2 ' 2k
fcode = 6000 / fr(kf)
ndraw = 1024: block = 5: gain = 0: nsg = 64: level = 0.2
FilePath = "e:\yjt\ABC.dat"
ExitFlag = False: k = 1
Timer1.Enabled = True
End Sub
Private Sub CmdSample_Click()
Dim Mess As Integer
If husb = 0 Then husb = OpenUA300()
If husb = 0 Then
Mess = MsgBox(" 设备打开错误!!! ", 0, "警告!")
Exit Sub
End If
If k > block Then k = 1
DelFlag = False: Lblnum.Caption = "等待第 " + Str$(k) + " 触发"
TmrSample = True
End Sub
Private Sub DrawAmp()
Dim amp As Single
Dim i As Integer
Dim th As Integer, h As Integer
th = Pic.ScaleHeight: h = th \ 8
amp = 5# / (2 ^ gain)
PicAmp.Cls
PicAmp.CurrentX = 120: PicAmp.CurrentY = 0 * h '1
PicAmp.Print Format(amp, "0.0000")
PicAmp.CurrentX = 120: PicAmp.CurrentY = 1 * h - 130 '2
PicAmp.Print Format(amp / 2, "0.0000")
PicAmp.CurrentX = 350: PicAmp.CurrentY = 2 * h - 130 '3
PicAmp.Print Format("0")
PicAmp.CurrentX = 50: PicAmp.CurrentY = 3 * h - 130 '4
PicAmp.Print Format(-amp / 2, "0.0000")
PicAmp.CurrentX = 50: PicAmp.CurrentY = 4 * h - 250 '5
PicAmp.Print Format(-amp, "0.0000")
'---------------------------------------------------------------------
PicAmp.CurrentX = 120: PicAmp.CurrentY = 4 * h '1
PicAmp.Print Format(amp, "0.0000")
PicAmp.CurrentX = 120: PicAmp.CurrentY = 5 * h - 130 '2
PicAmp.Print Format(amp / 2, "0.0000")
PicAmp.CurrentX = 350: PicAmp.CurrentY = 6 * h - 130 '3
PicAmp.Print Format("0")
PicAmp.CurrentX = 50: PicAmp.CurrentY = 7 * h - 130 '4
PicAmp.Print Format(-amp / 2, "0.0000")
PicAmp.CurrentX = 50: PicAmp.CurrentY = 8 * h - 250 '5
PicAmp.Print Format(-amp, "0.0000")
End Sub
Private Sub Background()
Dim j As Integer
Dim tw As Integer, th As Integer
Dim w As Integer, h As Integer
tw = Pic.ScaleWidth: th = Pic.ScaleHeight
h = th \ 8: w = tw \ 4
Pic.Line (10, 10)-(tw - 30, th - 30), QBColor(7), B
'--------------------------画网格-------------
Pic.DrawStyle = 3
For j = 1 To 3
Pic.Line (j * w, 0)-(j * w, tw), QBColor(7)
Next j
For j = 1 To 7
If j <> 4 Then Pic.Line (0, j * h)-(tw, j * h), QBColor(7)
Next j
Pic.DrawStyle = 0
End Sub
Private Sub DrawTime()
Dim j As Integer, ts As Single, fs As Single
Dim tw As Integer, w As Integer
tw = Pic.ScaleWidth: w = tw \ 4
fs = CSng(fr(kf)) / 2# ' * 1000#
PicTime.Cls
PicTime.CurrentX = 700: PicTime.CurrentY = 50: PicTime.Print 0
For j = 1 To 3
PicTime.CurrentX = w * j + 500: PicTime.CurrentY = 50
ts = CSng(ndraw * j / 4) / fs
PicTime.Print Format(ts, "0.000")
Next j
PicTime.CurrentX = tw - 100: PicTime.CurrentY = 50
PicTime.Print Format(ndraw / fs, "0.000")
End Sub
Private Sub DrawCurve2()
Dim amp As Single
Dim i As Integer, j As Integer
Dim tw As Integer, th As Integer
Dim h As Integer, y0 As Integer
tw = Pic.ScaleWidth: th = Pic.ScaleHeight
h = th \ 2: y0 = th \ 4
amp = CSng(h) / 4096#
Pic.Line (0, h)-(tw, h) '通道分隔线
'ndraw = 1024
For j = 0 To 1
Pic.PSet (0, -Int(dd1(j) * amp) + h * j + y0)
For i = 0 To ndraw - 1
Pic.Line -(tw / CSng(ndraw) * i, -Int(dd1(2 * i + j) * amp) + y0 + h * j), RGB(220, 220, 20)
Next i
Next j
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False
Pic.Cls
Call DrawAmp
Call Background: Pic.Line (0, Pic.ScaleHeight \ 2)-(Pic.ScaleWidth, Pic.ScaleHeight \ 2) '通道分隔线
Call DrawTime
End Sub
Private Sub TmrSample_Timer()
Dim i As Integer, j As Integer, temp As Single
TmrSample.Enabled = False
Call startad(husb, 0, 2, fcode, gain)
For j = 0 To 1 Step 0
Call readdata2(husb, dd0(0), nsg * 2)
For i = 0 To 2 * nsg - 1
dd1(i) = (dd0(i) And &HFFF) - 2048
Next i
For i = 0 To nsg - 2
temp = (dd1(2 * i) / 2048# * 5#) / (2 ^ gain)
If Abs(temp) >= level Then GoTo lab
Next i
DoEvents
If ExitFlag = True Then Exit Sub
Next j
lab:
Call readdata2(husb, dd2(0), ndraw * 2)
For i = 0 To nsg * 2 - 1
dd1(i) = dd0(i)
Next i
For i = 0 To ndraw * 2
dd1(i + 2 * nsg) = dd2(i)
Next i
Call endread2(husb)
Call SaveTr(k)
For i = 0 To 2 * ndraw - 1
dd1(i) = (dd1(i) And &HFFF) - 2048
Next i
Pic.Cls: PicAmp.Cls: PicTime.Cls
Call DrawCurve2: Call DrawAmp: Call DrawTime
Call Background: Pic.Line (0, Pic.ScaleHeight \ 2)-(Pic.ScaleWidth, Pic.ScaleHeight \ 2) '通道分隔线
Lblnum.Caption = "第 " + Str(k) + " 次采样完成"
k = k + 1
If k > block Then Lblnum.Caption = "采样结束"
End Sub
Private Sub SaveTr(k As Integer)
Dim i As Integer, position As Integer
position = (k - 1) * ndraw * 2
Open FilePath For Random Access Write As #1 Len = 2
For i = 1 To ndraw * 2
Put #1, position + i, dd1(i - 1)
Next i
Close #1
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?