frmrecord.frm

用VB实现正弦波的采集和傅里叶变换。将时域信号变化为频域信号

Private CurveFlag  As Boolean         '曲线标志
Private ch         As Integer         '通道号
Private rms As Single, kurt As Single

Private Sub CmdCh_Click()
  ch = ch + 1
  If ch = 4 Then ch = 0
   LblCh.Caption = " 通道 " + Str$(ch)

End Sub

Private Sub CmdEnd_Click()
  
  'CloseUA300 (husb)
  Unload FrmRecord
 
End Sub

Private Sub CmdFM_Click()
  kf = kf + 1
  If kf = 6 Then kf = 5
  fcode = 6000 / fr(kf)
  LblFreq.Caption = "采样频率:" + Str$(fr(kf)) + "K Hz"
  Call DrawTime
  
End Sub

Private Sub CmdFP_Click()
  kf = kf - 1
  If kf = -1 Then kf = 0
  fcode = 6000 / fr(kf)
  LblFreq.Caption = "采样频率:" + Str$(fr(kf)) + "K Hz"
  Call DrawTime
  
End Sub

Private Sub CmdGP_Click()
  
  gain = gain + 1
  If gain > 4 Then gain = 4
  Call DrawAmp
 
End Sub

Private Sub CmdGM_Click()
  
  gain = gain - 1
  If gain < 0 Then gain = 0
  Call DrawAmp
 
End Sub

Private Sub CmdRead_Click()
  Dim FilePath As String
  Dim i As Integer, j As Long, k As Long
  
  On Error GoTo Errhandler
  CmDialog1.Action = 1
  
Errhandler:

  If Err = 32755 Then
     Exit Sub
  Else
     FilePath = CmDialog1.filename
  End If
  
  Open FilePath For Random Access Read As #1 Len = 2
  For j = 0 To 39
    k = j * 1024 + 1
    For i = 0 To ndraw - 1
       Get #1, k, dd1(i)
       k = k + 1
    Next i
    
    For i = 0 To ndraw - 1
      dd1(i) = (dd1(i) And &HFFF) - 2048
    Next i
   
    Pic.Cls
    Timer2.Enabled = True
    Call DrawCurve
    Call Background
    DoEvents
  Next j
  Close #1
  
End Sub

Private Sub CmdSave_Click()
  Dim FilePath As String
  Dim j As Integer, i As Integer, k As Long
  
  On Error GoTo Errhandler
  CmDialog1.Action = 2
  
Errhandler:

  If Err = 32755 Then
     Exit Sub
  Else
     FilePath = CmDialog1.filename
  End If
  
  k = Len(FilePath) - 3: FilePath = Left$(FilePath, k) + "sts"
  Open FilePath For Output As #1
    Write #1, "采样频率:" + Str$(fr(kf)) + " K Hz"
    Write #1, "gain = " + Str$(gain)
  Close #1
  FilePath = CmDialog1.filename
  
  Call startad(husb, ch, 1, fcode, gain)
  Open FilePath For Random Access Write As #1 Len = 2
     k = 1
     For j = 1 To 10
       Call readdata2(husb, dd1(0), 4096)
       For i = 0 To 4095
         Put #1, k, dd1(i)
         k = k + 1
       Next i
     Next j
  Close #1
  Call endread2(husb)
   
End Sub

Private Sub Form_Load()
  
  kf = 0
  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)
'===================
  gain = 0
  ch = 0
  ndraw = 1024
 
  CurveFlag = True
  LblFreq.Caption = " 采样频率:" + Str$(fr(kf)) + "K Hz"
  LblCh.Caption = " 通道 " + Str$(ch)
  Call DrawAmp
  Call Background
  Call DrawTime
  
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
  FrmRecord.Caption = FrmRecord.Caption + Hex$(GetVer(husb))
  
  TimerSample.Enabled = True
    
End Sub


Private Sub OptCurve_Click()
  CurveFlag = True
End Sub

Private Sub OptList_Click()
  CurveFlag = False
End Sub

Private Sub Pic_Click()
  If TimerSample.Enabled = False Then
    TimerSample.Enabled = True
  Else
    TimerSample.Enabled = False
  End If
End Sub

Private Sub Timer2_Timer()
  Timer2.Enabled = False
  
End Sub

Private Sub TimerSample_Timer()
  Dim i As Integer, amp As Single
  Dim xr0(1024) As Single, temp As Single
  Dim pr As String
  
  Call minit(husb, ch, 1, gain)
  Call readdata(husb, dd1(0), fcode, ndraw)
  
  ' Call startad(husb, ch, 1, fcode, gain)
  ' Call readdata2(husb, dd1(0), 1024)
  ' Call endread2(husb)
   
  For i = 0 To ndraw - 1
     dd1(i) = (dd1(i) And &HFFF) - 2048
  Next i
  
  Pic.Cls
   
  If CurveFlag = True Then
    For i = 0 To ndraw - 1
      xr0(i) = (CSng(dd1(i)) / 2048# * 5#) / (2 ^ gain)
    Next i
    Call ExtractIndex(ndraw, xr0, rms, kurt)
    Call DrawCurve
    Call Background
  Else
    'ndraw = 256
    Pic.CurrentX = 1000: Pic.CurrentY = 100
    For i = 0 To ndraw - 1
      temp = (dd1(i) / 2048# * 5#) / (2 ^ gain)
      pr = Format$(temp, "0.0000")
      Pic.CurrentX = 1000: Pic.Print pr: Pic.Print
    Next i
  End If
  
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 * 0.75, "0.0000")
  PicAmp.CurrentX = 120: PicAmp.CurrentY = 2 * h - 130  '3
  PicAmp.Print Format(amp / 2#, "0.0000")
  PicAmp.CurrentX = 120: PicAmp.CurrentY = 3 * h - 130  '4
  PicAmp.Print Format(amp / 4#, "0.0000")
  PicAmp.CurrentX = 350: PicAmp.CurrentY = 4 * h - 130  '5
  PicAmp.Print Format("0")

  PicAmp.CurrentX = 50: PicAmp.CurrentY = 5 * h - 130   '6
  PicAmp.Print Format(-amp / 4#, "0.0000")
  PicAmp.CurrentX = 50: PicAmp.CurrentY = 6 * h - 130   '7
  PicAmp.Print Format(-amp / 2#, "0.0000")
  PicAmp.CurrentX = 50: PicAmp.CurrentY = 7 * h - 130  '8
  PicAmp.Print Format(-amp * 0.75, "0.0000")
  PicAmp.CurrentX = 50: PicAmp.CurrentY = 8 * h - 250  '9
  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
    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)) ' * 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 ' * 1000#
    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 DrawCurve()
Dim amp As Single, i As Integer
Dim tw As Integer, th As Integer
Dim h As Integer, y0 As Integer
  
   tw = Pic.ScaleWidth: th = Pic.ScaleHeight
   h = th: y0 = th \ 2
   amp = CSng(h) / 4096#
  
   ' ndraw = 1024
    Pic.PSet (0, -Int(dd1(0) * amp) + y0)
    For i = 0 To ndraw - 1
       Pic.Line -(tw / CSng(ndraw) * i, -Int(dd1(i) * amp) + y0), RGB(220, 220, 20)
    Next i
    Pic.ForeColor = QBColor(7)
    Pic.CurrentX = tw - 1500: Pic.CurrentY = 50:  Pic.Print "rms = "; Format$(rms, "0.000")
    Pic.CurrentX = tw - 1500: Pic.CurrentY = 250: Pic.Print "kurt = "; Format$(kurt, "0.000")
    
End Sub