VERSION 5.00
Begin VB.Form form1 
   Caption         =   "一維傅里葉變換"
   ClientHeight    =   6300
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   11655
   LinkTopic       =   "Form1"
   ScaleHeight     =   420
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   777
   StartUpPosition =   2  '屏幕中心
   Begin VB.VScrollBar VScroll1 
      Enabled         =   0   'False
      Height          =   6195
      Left            =   11340
      Max             =   100
      TabIndex        =   2
      Top             =   60
      Value           =   50
      Width           =   255
   End
   Begin VB.PictureBox Picture2 
      BackColor       =   &H00FF0000&
      Height          =   3075
      Left            =   60
      ScaleHeight     =   201
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   745
      TabIndex        =   1
      Top             =   3180
      Width           =   11235
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H00FF0000&
      Height          =   3075
      Left            =   60
      ScaleHeight     =   201
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   745
      TabIndex        =   0
      Top             =   60
      Width           =   11235
   End
   Begin VB.Menu menu 
      Caption         =   "函數"
      Begin VB.Menu menu1 
         Caption         =   "常數函數"
      End
      Begin VB.Menu menu2 
         Caption         =   "點函數"
      End
      Begin VB.Menu menu3 
         Caption         =   "Sin函數"
      End
      Begin VB.Menu menu4 
         Caption         =   "Sinc函數"
      End
      Begin VB.Menu menu5 
         Caption         =   "矩形函數"
      End
      Begin VB.Menu menu6 
         Caption         =   "三角函數"
      End
      Begin VB.Menu menu7 
         Caption         =   "隨機函數"
      End
   End
   Begin VB.Menu menuq 
      Caption         =   "退出"
   End
End
Attribute VB_Name = "form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim x() As Single
Dim bz As Integer

Private Sub Form_Load()
    ReDim xr(1023) As Single
    ReDim xi(1023) As Single
    ReDim x(1023) As Single
    bz = 1
End Sub

Private Sub picshow(b As Boolean, p As PictureBox)
    '曲線顯示程序
    Dim max As Single, min As Single
    Dim i As Integer
    Dim w As Single, h As Single
    '計算頻譜值,最大最小值
    max = -1E+30
    min = 1E+30
    For i = 0 To 1023
        If b Then
            x(i) = Log(1# + Sqr(xr(i) * xr(i) + xi(i) * xi(i)))
        Else
            x(i) = xr(i)
        End If
        If x(i) > max Then max = x(i)
        If x(i) < min Then min = x(i)
    Next i
    '畫圖
    w = (p.ScaleWidth - 10) / 1023
    If max - min = 0 Then
        h = 0
    Else
        h = (p.ScaleHeight - 10) / (max - min)
    End If
    p.Cls
    '畫第一點
    p.PSet (5, 5 + (max - x(0)) * h), &HFFFFFF
    '畫其余線
    For i = 1 To 1023
        p.Line -(5 + i * w, 5 + (max - x(i)) * h), &HFFFFFF
    Next i
End Sub

Private Sub menu1_Click()
    VScroll1.Enabled = False
    bz = 1
    Call xxx
End Sub

Private Sub menu2_Click()
    VScroll1.Enabled = False
    bz = 2
    Call xxx
End Sub

Private Sub menu3_Click()
    bz = 3
    VScroll1.Enabled = True
    VScroll1.min = -30
    VScroll1.max = 70
    VScroll1.Value = 20
    Call xxx
End Sub

Private Sub menu4_Click()
    bz = 4
    VScroll1.Enabled = True
    VScroll1.min = -40
    VScroll1.max = 60
    VScroll1.Value = 10
    Call xxx
End Sub

Private Sub menu5_Click()
    bz = 5
    VScroll1.Enabled = True
    VScroll1.min = 1
    VScroll1.max = 511
    VScroll1.Value = 500
    Call xxx
End Sub

Private Sub menu6_Click()
    bz = 6
    VScroll1.Enabled = True
    VScroll1.min = 1
    VScroll1.max = 511
    VScroll1.Value = 500
    Call xxx
End Sub

Private Sub menu7_Click()
    VScroll1.Enabled = False
    bz = 7
    Call xxx

End Sub

Private Sub menuq_Click()
    End
End Sub

Private Sub xxx()
    Dim i As Integer
    Dim x As Single
    Dim pi As Single
    pi = 4 * Atn(1)
    Select Case bz
    Case 1
        '常數函數
        For i = 0 To 1023
            xr(i) = 1
            xi(i) = 0
        Next i
    Case 2
        '點函數
        For i = 0 To 1023
            xr(i) = 0
            xi(i) = 0
        Next i
        xr(512) = 1
    Case 3
        'Sin 函數
        For i = 0 To 1023
            xr(i) = Sin(0.01 * VScroll1.Value * (i - 512))
            xi(i) = 0
        Next i
    Case 4
        'Sinc 函數
        For i = 0 To 1023
            x = 0.01 * VScroll1.Value * pi * (i - 512)
            If x = 0 Then
                xr(i) = 1
            Else
                xr(i) = Sin(x) / x
            End If
            xi(i) = 0
        Next i
    Case 5
        '矩形函數
        For i = 0 To 511
            If i < VScroll1.Value Then
                xr(i) = 0
                xr(1023 - i) = 0
            Else
                xr(i) = 1
                xr(1023 - i) = 1
            End If
            xi(i) = 0
            xi(1023 - i) = 0
        Next i
    Case 6
        '三角函數
        For i = 0 To 511
            If i < VScroll1.Value Then
                xr(i) = 0
                xr(1023 - i) = 0
            Else
                xr(i) = (i - VScroll1.Value) / 511
                xr(1023 - i) = xr(i)
            End If
            xi(i) = 0
            xi(1023 - i) = 0
        Next i
    Case 7
        '隨機函數
        For i = 0 To 1023
            xr(i) = Rnd
            xi(i) = 0
        Next i
    End Select
    '顯示函數曲線
    Call picshow(False, Picture1)
    '傅里葉變換
    For i = 0 To 1023
        xr(i) = xr(i) * (-1) ^ i
    Next i
    Call FFT(1024, True)
    '顯示頻譜曲線
    Call picshow(True, Picture2)
End Sub

Private Sub VScroll1_Change()
    Call xxx
End Sub