frmch4.frm

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

  'CloseUA300 (husb)
  Unload FrmCh4
 
End Sub

Private Sub CmdFM_Click()
  kf = kf + 1
  If kf = 6 Then kf = 5
  fcode = 6000 / fr(kf)
  LblFreq.Caption = "采样频率:" + Str$(fr(kf) / 4) + "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) / 4) + "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 * 4 * ndraw + 1
    For i = 0 To 4 * ndraw - 1
       Get #1, k, dd1(i)
       k = k + 1
    Next i
    
    For i = 0 To 4 * ndraw - 1
      dd1(i) = (dd1(i) And &HFFF) - 2048
    Next i
   
    Pic.Cls
    Timer2.Enabled = True
    Call DrawCurve4
    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) / 4) + " K Hz"
    Write #1, "gain = " + Str$(gain)
  Close #1
  FilePath = CmDialog1.filename

  Call startad(husb, 0, 4, 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 * 4)
       For i = 0 To 4096 * 4 - 1
         Put #1, k, dd1(i)
         k = k + 1
       Next i
     Next j
  Close #1
  Call endread2(husb)
  
End Sub

Private Sub Form_Load()
  
  FrmOsc.Caption = "双通道示波器"
  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
  ndraw = 1024
 
  CurveFlag = True
  LblFreq.Caption = "采样频率:" + Str$(fr(kf) \ 4) + "K Hz"
  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
  FrmOsc.Caption = FrmOsc.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 TimerSample_Timer()
  Dim temp As Single, pr As String
  Dim i As Integer, amp As Single
 
  Call minit(husb, 0, 4, gain)
  Call readdata(husb, dd1(0), fcode, ndraw * 4)
   
  For i = 0 To ndraw * 4 - 1
    dd1(i) = (dd1(i) And &HFFF) - 2048
  Next i
  Pic.Cls
  
  If CurveFlag = True Then
    Call ExtractRK(ndraw, 4, dd1)
    Call DrawCurve4
    Call Background
  Else
    'ndraw = 256
    Pic.CurrentX = 0: Pic.CurrentY = 100
    For i = 1 To ndraw
      temp = (dd1(i - 1) / 2048# * 5#) / (2 ^ gain)
      pr = Format$(temp, "0.0000")
      If temp >= 0# Then pr = " " + pr
      Pic.Print pr,
      Pic.Print ,
      If i Mod 4 = 0 Then 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 \ 4
  amp = 5# / (2 ^ gain)
  PicAmp.Cls
  For i = 0 To 3
    PicAmp.CurrentX = 120: PicAmp.CurrentY = i * h                     '5v
    PicAmp.Print Format(amp, "0.0000")
    PicAmp.CurrentX = 350: PicAmp.CurrentY = i * h + th \ 8 - 130      '0
    PicAmp.Print Format("0")
    PicAmp.CurrentX = 50: PicAmp.CurrentY = i * h + th \ 4 - 250       '-5v
    PicAmp.Print Format(-amp, "0.0000")
  Next i
  
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 \ 16: 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 15
    If (j Mod 4) <> 0 Then Pic.Line (0, j * h)-(tw, j * h), QBColor(7)
  Next j
  Pic.DrawStyle = 0

  Pic.Line (0, Pic.ScaleHeight \ 4)-(Pic.ScaleWidth, Pic.ScaleHeight \ 4)           '通道分隔线
  Pic.Line (0, Pic.ScaleHeight \ 2)-(Pic.ScaleWidth, Pic.ScaleHeight \ 2)
  Pic.Line (0, 3 * Pic.ScaleHeight \ 4)-(Pic.ScaleWidth, 3 * Pic.ScaleHeight \ 4)
  
  
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)) / 4# ' * 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 DrawCurve4()
  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 \ 4: y0 = th \ 8
  amp = CSng(h) / 4096#
  
   'ndraw = 1024
    For j = 0 To 3
      Pic.PSet (0, -Int(dd1(j) * amp) + h * j + y0)
      For i = 0 To ndraw - 1
        Pic.Line -(tw / CSng(ndraw) * i, -Int(dd1(4 * i + j) * amp) + y0 + h * j), RGB(220, 220, 20)
      Next i
      Pic.ForeColor = QBColor(7)
      Pic.CurrentX = tw - 1500: Pic.CurrentY = 50 + j * h: Pic.Print "rms = "; Format$(Irms(j), "0.000")
      Pic.CurrentX = tw - 1500: Pic.CurrentY = 250 + j * h: Pic.Print "kurt = "; Format$(Ikurt(j), "0.000")
    Next j
    
End Sub

Private Sub ExtractRK(n As Integer, chm As Integer, dd1() As Integer)
Dim i As Integer, j As Integer
Dim xr0(1024) As Single
Dim rms As Single, kurt As Single
  For j = 0 To chm - 1
    For i = 0 To n - 1
      xr0(i) = (CSng(dd1(chm * i + j)) / 2048# * 5#) / (2 ^ gain)
      Call ExtractIndex(n, xr0, rms, kurt)
      Irms(j) = rms: Ikurt(j) = kurt
    Next i
  Next j
End Sub