frmspectrum.frm

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

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

End Sub

Private Sub CmdEnd_Click()
  
  'CloseUA300 (husb)
  Unload FrmSpectrum
 
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: Call DrawFreq
  
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:  Call DrawFreq
  
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
    
    Pic0.Cls
    Timer2.Enabled = True
    Call DrawCurve
    Call Background0
    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 = 4096 '1024
  LogFlag = False
 
  LblFreq.Caption = " 采样频率:" + Str$(fr(kf)) + "K Hz"
  LblCh.Caption = " 通道 " + Str$(ch)
  Call DrawMAG:     Call DrawAmp
  Call Background0: Call Background1
  Call DrawFreq:    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 Pic0_Click()
  If TimerSample.Enabled = False Then
    TimerSample.Enabled = True
  Else
    TimerSample.Enabled = False
  End If
End Sub

Private Sub OptLine_Click()
  LogFlag = False
End Sub

Private Sub Optlog_Click()
   LogFlag = True
End Sub

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

Private Sub TimerSample_Timer()
  Dim temp As Single, amp As Single
  Dim i As Integer, j As Integer
  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)
  
  Pic0.Cls:         Pic1.Cls
  Call DrawCurve:   Call DrawPower(1)
  Call Background0: Call Background1
  
End Sub

Private Sub DrawAmp()
  Dim amp As Single
  Dim i As Integer
  Dim th As Integer, h As Integer
   
  th = Pic0.ScaleHeight:  h = th \ 4
  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.5, "0.0000")
  PicAmp.CurrentX = 350: PicAmp.CurrentY = 2 * h - 130  '3
  PicAmp.Print Format("0")

  PicAmp.CurrentX = 50: PicAmp.CurrentY = 3 * h - 130   '6
  PicAmp.Print Format(-amp * 0.5, "0.0000")
  PicAmp.CurrentX = 50: PicAmp.CurrentY = 4 * h - 250  '9
  PicAmp.Print Format(-amp, "0.0000")

End Sub

Private Sub DrawMAG()
  Dim amp As Single
  Dim i As Integer
  Dim th As Integer, h As Integer
   
  th = Pic1.ScaleHeight:  h = th \ 4
  amp = 1# / 4#
  PicAg.Cls
  
  PicAg.CurrentX = 120: PicAg.CurrentY = 0 * h        '1
  PicAg.Print Format(amp * 4#, "0.0000")
  PicAg.CurrentX = 120: PicAg.CurrentY = 1 * h - 130  '2
  PicAg.Print Format(amp * 3#, "0.0000")
  PicAg.CurrentX = 120: PicAg.CurrentY = 2 * h - 130  '3
  PicAg.Print Format(amp * 2#, "0.0000")
  PicAg.CurrentX = 120: PicAg.CurrentY = 3 * h - 130  '4
  PicAg.Print Format(amp * 1#, "0.0000")
  PicAg.CurrentX = 350: PicAg.CurrentY = 4 * h - 250  '9
  PicAg.Print Format(0, "0")

End Sub

Private Sub DrawMAGLog()
  Dim temp As Integer
  Dim i As Integer
  Dim th As Integer, h As Integer
   
  th = Pic1.ScaleHeight:  h = th \ 4
  temp = -40
  PicAg.Cls
  
  PicAg.CurrentX = 450: PicAg.CurrentY = 0 * h        '1
  PicAg.Print Format(temp * 0, "0")
  PicAg.CurrentX = 300: PicAg.CurrentY = 1 * h - 130  '2
  PicAg.Print Format(temp * 1, "0")
  PicAg.CurrentX = 300: PicAg.CurrentY = 2 * h - 130  '3
  PicAg.Print Format(temp * 2, "0")
  PicAg.CurrentX = 300: PicAg.CurrentY = 3 * h - 130  '4
  PicAg.Print Format(temp * 3, "0")
  PicAg.CurrentX = 300: PicAg.CurrentY = 4 * h - 250  '9
  PicAg.Print Format(temp * 4, "0")

End Sub

Private Sub Background0()
  Dim j As Integer
  Dim tw As Integer, th As Integer
  Dim w As Integer, h As Integer
   
  tw = Pic0.ScaleWidth: th = Pic0.ScaleHeight
  h = th \ 4: w = tw \ 4
  Pic0.Line (10, 10)-(tw - 30, th - 30), QBColor(7), B
  '--------------------------画网格-------------
  Pic0.DrawStyle = 3
  For j = 1 To 3
    Pic0.Line (j * w, 0)-(j * w, tw), QBColor(7)
  Next j
  For j = 1 To 3
    Pic0.Line (0, j * h)-(tw, j * h), QBColor(7)
  Next j
  Pic0.DrawStyle = 0
 
End Sub

Private Sub Background1()
  Dim j As Integer
  Dim tw As Integer, th As Integer
  Dim w As Integer, h As Integer
   
  tw = Pic1.ScaleWidth: th = Pic1.ScaleHeight
  h = th \ 4: w = tw \ 4
  Pic1.Line (10, 10)-(tw - 30, th - 30), QBColor(7), B
  '--------------------------画网格-------------
  Pic1.DrawStyle = 3
  For j = 1 To 3
    Pic1.Line (j * w, 0)-(j * w, tw), QBColor(7)
  Next j
  For j = 1 To 3
    Pic1.Line (0, j * h)-(tw, j * h), QBColor(7)
  Next j
  Pic1.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 = Pic0.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 DrawFreq()
  Dim j As Integer, ts As Single, fs As Single
  Dim tw As Integer, w As Integer

  tw = Pic1.ScaleWidth: w = tw \ 4
  fs = CSng(fr(kf)) * 1000#
  
  PicFreq.Cls
  PicFreq.CurrentX = 700: PicFreq.CurrentY = 50: PicFreq.Print 0
  For j = 1 To 3
    PicFreq.CurrentX = w * j + 500: PicFreq.CurrentY = 50
    ts = CSng(fs / 8# * j)
    PicFreq.Print Format(ts, "0")
  Next j
  PicFreq.CurrentX = tw - 50: PicFreq.CurrentY = 50
  PicFreq.Print Format(fs / 2#, "0")
    
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 = Pic0.ScaleWidth: th = Pic0.ScaleHeight
   h = th: y0 = th \ 2
   amp = CSng(h) / 4096#
   
   For i = 0 To ndraw - 1
     dd1(i) = (dd1(i) And &HFFF) - 2048
   Next i
   
   ' ndraw = 1024
    Pic0.PSet (0, -Int(dd1(0) * amp) + y0)
    For i = 0 To ndraw - 1
       Pic0.Line -(tw / CSng(ndraw) * i, -Int(dd1(i) * amp) + y0), RGB(220, 220, 20)
    Next i
    
End Sub

Private Sub DrawPower(navg As Integer)
Dim xr(4096) As Single, xi(4096) As Single
Dim spec(4096) As Single
Dim i As Integer, k As Integer
Dim ymax As Single, fmax As Integer, amp As Single
Dim tw As Integer, h As Integer
Dim freq As Single

  For i = 0 To ndraw - 1
     spec(i) = 0#
  Next i
  
   For i = 0 To ndraw - 1
     dd1(i) = (dd1(i) And &HFFF) - 2048
   Next i
   
For k = 0 To navg - 1
  For i = 0 To ndraw - 1
    xr(i) = (dd1(k * ndraw + i) And &HFFF) - 2048
    xr(i) = CSng(dd1(i)) / 2048#
    xi(i) = 0#
  Next i
  Call PreProcess(ndraw, xr)
  Call FFT3(ndraw, xr, xi, 0)
  For i = 0 To ndraw - 1
    spec(i) = spec(i) + (xr(i) * xr(i) + xi(i) * xi(i)) / (CSng(ndraw) * CSng(ndraw))
  Next i
Next k
  For i = 0 To ndraw - 1
     xr(i) = spec(i) / CSng(navg)
  Next i
    
  ymax = xr(0): fmax = 0
  For i = 1 To ndraw \ 2 - 1
     If xr(i) > ymax Then
        ymax = xr(i): fmax = i
     End If
  Next i
  'freq = 4096# / CSng(ndraw) * CSng(fmax)
  freq = CSng(fr(kf)) * 1000# / CSng(ndraw) * CSng(fmax)
  LblFmax.Caption = Format(freq, "0.0") + " Hz"
  
  
  If LogFlag = False Then     '线性标度
   
     tw = Pic1.ScaleWidth: h = Pic1.ScaleHeight
     amp = CSng(h) / ymax
     Pic1.PSet (0, -Int(xr(0) * amp) + h)
     For i = 0 To ndraw \ 2 - 1
        Pic1.Line -(tw / CSng(ndraw \ 2) * i, -Int(xr(i) * amp) + h), RGB(220, 220, 20)
     Next i
     Call DrawMAG
  Else                        ' 对数标度
   
     For i = 0 To ndraw - 1
       xr(i) = xr(i) / ymax
       If xr(i) = 0 Then xr(i) = 0.00001
       xr(i) = 20# * Log(xr(i)) / Log(10#)
     Next i
     
     ymax = xr(0)
     For i = 1 To ndraw \ 2 - 1
       If xr(i) > ymax Then
         ymax = xr(i)
      End If
     Next i
     
     tw = Pic1.ScaleWidth: h = Pic1.ScaleHeight
     amp = -CSng(h) / 160#
     Pic1.PSet (0, -Int(xr(0) * amp))
     For i = 0 To ndraw \ 2 - 1
        Pic1.Line -(tw / CSng(ndraw \ 2) * i, Int(xr(i) * amp)), RGB(220, 220, 20)
     Next i
     Call DrawMAGLog
  End If
 
End Sub