⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 fft.frm

📁 自编FFT谱分析中的栅栏效应演示
💻 FRM
字号:
VERSION 5.00
Begin VB.Form Form1 
   AutoRedraw      =   -1  'True
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   5565
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7800
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   ScaleHeight     =   371
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   520
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text2 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      Height          =   285
      Left            =   6360
      TabIndex        =   8
      Text            =   "0.0001953125"
      Top             =   4740
      Width           =   1185
   End
   Begin VB.TextBox Text1 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      Height          =   270
      Left            =   4560
      TabIndex        =   6
      Text            =   "505"
      Top             =   4740
      Width           =   645
   End
   Begin VB.PictureBox Picture2 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      BackColor       =   &H00C0C0C0&
      ForeColor       =   &H80000008&
      Height          =   3045
      Left            =   30
      ScaleHeight     =   201
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   515
      TabIndex        =   2
      Top             =   1620
      Width           =   7755
      Begin VB.Line Line1 
         BorderColor     =   &H000080FF&
         Visible         =   0   'False
         X1              =   0
         X2              =   0
         Y1              =   0
         Y2              =   201
      End
   End
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      BackColor       =   &H00C0C0C0&
      ForeColor       =   &H80000008&
      Height          =   1545
      Left            =   30
      ScaleHeight     =   101
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   515
      TabIndex        =   1
      Top             =   30
      Width           =   7755
   End
   Begin VB.CommandButton Command1 
      Caption         =   "变  换"
      Default         =   -1  'True
      Height          =   315
      Left            =   6270
      TabIndex        =   0
      Top             =   5130
      Width           =   1095
   End
   Begin VB.Label Label9 
      Caption         =   "采样时间:"
      Height          =   195
      Left            =   3210
      TabIndex        =   13
      Top             =   5190
      Width           =   1995
   End
   Begin VB.Label Label8 
      Caption         =   "s"
      Height          =   225
      Left            =   7560
      TabIndex        =   12
      Top             =   4770
      Width           =   195
   End
   Begin VB.Label Label7 
      Caption         =   "Hz"
      Height          =   225
      Left            =   5220
      TabIndex        =   11
      Top             =   4770
      Width           =   255
   End
   Begin VB.Label Label6 
      Caption         =   "采样频率:5120Hz"
      Height          =   195
      Left            =   1260
      TabIndex        =   10
      Top             =   5190
      Width           =   1665
   End
   Begin VB.Label Label5 
      Caption         =   "采样数:512"
      Height          =   195
      Left            =   90
      TabIndex        =   9
      Top             =   5190
      Width           =   975
   End
   Begin VB.Label Label4 
      Caption         =   "采样间隔:"
      Height          =   225
      Left            =   5520
      TabIndex        =   7
      Top             =   4770
      Width           =   825
   End
   Begin VB.Label Label3 
      Caption         =   "周期信号的频率:"
      Height          =   225
      Left            =   3210
      TabIndex        =   5
      Top             =   4770
      Width           =   1395
   End
   Begin VB.Label Label2 
      Caption         =   "振幅:"
      Height          =   225
      Left            =   1680
      TabIndex        =   4
      Top             =   4770
      Width           =   1485
   End
   Begin VB.Label Label1 
      Caption         =   "频率:"
      Height          =   225
      Left            =   60
      TabIndex        =   3
      Top             =   4770
      Width           =   1545
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private dt As Double, Freq As Double, Is_Transforms As Boolean

Private Sub Command1_Click() '进行快速傅立叶变换
  Dim dTemp As Double, oTemp As Double
  
  'Me.Cls
  dt = Val(Text2.Text)
  Label9.Caption = "采样时间:" + Str(Format(dt * 512 / 1000, ".00000")) + "ms"
  Label6.Caption = "采样频率:" + Str(Format(1 / dt, ".00")) + "Hz"
  Freq = Val(Text1.Text)
  Picture1.Cls
  Collect
  
  FFT TD(), FD(), 9
  
  Picture2.Cls
    
  For i = 0 To 511 \ 2
  
    With FD(i)
      
      dTemp = Sqr(.Re * .Re + .Im * .Im)
    
    End With
    
    
    Picture2.Line (i * 2, 200)-(i * 2, 200 - dTemp)
    'If i > 0 Then Picture2.Line ((i - 1) * 2, 200 - oTemp)-(i * 2, 200 - dTemp)
    'oTemp = dTemp
    Line1.Visible = True
    Label1.Visible = True
    Label2.Visible = True
  Next i
  
  Is_Transforms = True
  
End Sub

Private Sub Form_Load() '采样
  
  Is_Transforms = False
  dt = Val(Text2.Text)
  Label9.Caption = "采样时间:" + Str(Format(dt * 512 / 1000, ".00000")) + "ms"
  Freq = Val(Text1.Text)
  Collect
  Command1_Click

End Sub

Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
  Select Case Button
    Case 0
      Line1.X1 = (X \ 2) * 2
      Line1.X2 = (X \ 2) * 2
      'nf=n/(dt*N) df=1/(dt*N)
      If Is_Transforms Then
        Label1.Caption = "频率:" + Str(Format((X \ 2) / (512 * dt), ".00")) + "Hz"
        
        With FD(X \ 2)
          dTemp = Sqr(.Re * .Re + .Im * .Im)
        End With
        
        Label2.Caption = "振幅:" + Str(Format(dTemp, ".00"))
      End If
    Case 1
    Case 2
  End Select
  'oX = X
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
  If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 46 Then KeyAscii = 0
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
  If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 46 Then KeyAscii = 0
End Sub

Private Sub Text1_Change()

  'If Val(Text1.Text) > 1 / Val(Text2.Text) Then
    Freq = 1 / Val(Text2.Text)
    'Text1.Text = Str(Freq)
  'End If

End Sub

Private Sub Text2_Change()
  dt = Val(Text2.Text)

  If Val(Text2.Text) > 1 / Val(Text1.Text) Then
    dt = 1 / Val(Text1.Text)
    Text2.Text = Str(Format(dt, ".0000000000"))
  End If
End Sub

Private Sub Collect()

  Dim i As Long
  For i = 0 To 511
    With TD(i)
      .Re = Cos(2 * PI * Freq * dt * i) '+ Sin(2 * PI * 20 * 0.005 * i)  '  +Exp(-i * 0.05)(1 / 5120)
      .Im = 0
    End With
    Picture1.Line (i * 2, 50)-(i * 2, 50 - 50 * TD(i).Re)
  Next i

  'Dim i As Long, t As Double
  'i = 0
  
  'Do
  '  With TD(i)
  '    .Re = Sin(2 * PI * 20 * t) '+ Sin(100 * t) + Sin(150 * t) + Sin(200 * t) + Sin(250 * t) + Sin(300 * t) + Sin(350 * t) + Sin(400 * t) + Sin(450 * t) + Sin(500 * t) + Sin(550 * t) + Sin(600 * t) + Sin(650 * t) + Sin(700 * t) + Sin(750 * t) + Sin(800 * t)
  '    .Im = 0
  '  End With
  '
  '  Me.Line (i * 2, 50)-(i * 2, 50 - 10 * TD(i).Re)
  '  i = i + 1
  '  t = t + 0.005 '采样频率为500,采样间隔0.002
  'Loop Until i = 256 '采样数为256

End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -