fft1.frm

用matlab语言对数字图像处理进行了系统的阐述

      Left            =   4080
      ScaleHeight     =   256
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   256
      TabIndex        =   3
      Top             =   240
      Width           =   3870
   End
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   3870
      Left            =   0
      ScaleHeight     =   256
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   256
      TabIndex        =   0
      Top             =   240
      Width           =   3870
   End
   Begin VB.PictureBox CommonDialog1 
      Height          =   480
      Left            =   4440
      ScaleHeight     =   420
      ScaleWidth      =   1140
      TabIndex        =   42
      Top             =   1620
      Width           =   1200
   End
   Begin VB.Label Label8 
      AutoSize        =   -1  'True
      Caption         =   "滤波器："
      Height          =   180
      Left            =   4140
      TabIndex        =   5
      Top             =   4140
      Width           =   720
   End
   Begin VB.Label Label7 
      AutoSize        =   -1  'True
      Caption         =   "还原图："
      Height          =   180
      Left            =   60
      TabIndex        =   4
      Top             =   4140
      Width           =   720
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      Caption         =   "频谱图："
      Height          =   180
      Left            =   4140
      TabIndex        =   2
      Top             =   60
      Width           =   720
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "原图："
      Height          =   180
      Left            =   60
      TabIndex        =   1
      Top             =   60
      Width           =   540
   End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit                                                 '显式定义变量
Dim xr(255) As Single, xi(255) As Single                        '工作函数
Dim ur(255, 255) As Single, ui(255, 255) As Single              '工作函数
Dim f(255, 255) As Single                                       '原函数
Dim pr(255, 255) As Single, pi(255, 255) As Single              '谱函数

Public Sub fft(ByVal v As Boolean)                              '一维傅氏变换子程序
    'v-变换形式:v=True为正变换,v=False为逆变换,xr()、xi()-输入、输出数据
    Dim i As Long, j As Long, k As Long, l As Long, l1 As Long, l2 As Long
    Dim wr As Single, wi As Single, a1 As Single, a2 As Single
    Dim p1 As Long, p2 As Long, t1 As Single, t2 As Single
    l1 = 256: a2 = 2.45436926061703E-02                         'a2=2*pi/n
    For l = 0 To 7                                              '蝶形计算
        l2 = l1: l1 = l1 / 2: a1 = 0
        For j = 0 To l1 - 1
            wr = Cos(a1): wi = IIf(v, -Sin(a1), Sin(a1))
            a1 = a1 + a2
            For i = l2 To 256 Step l2
                p1 = i - l2 + j:            p2 = p1 + l1
                t1 = xr(p1) - xr(p2):       t2 = xi(p1) - xi(p2)
                xr(p1) = xr(p1) + xr(p2):   xi(p1) = xi(p1) + xi(p2)
                xr(p2) = wr * t1 + wi * t2: xi(p2) = wr * t2 - wi * t1
            Next i
        Next j
        a2 = a2 + a2
    Next l
    j = 0                                                       '码位到置
    For i = 0 To 254
        If i < j Then
            a1 = xr(j): xr(j) = xr(i): xr(i) = a1
            a1 = xi(j): xi(j) = xi(i): xi(i) = a1
        End If
        k = 128
        Do While (k <= j)
            j = j - k: k = k \ 2
        Loop
        j = j + k
    Next i
    For i = 0 To 255                                            '系数
        xr(i) = 0.0625 * xr(i): xi(i) = 0.0625 * xi(i)
    Next i
End Sub

Private Sub fft2(ByVal z As Boolean)                            '二维傅傅氏变换子程序
    'z-变换形式:z=True为正变换,z=False为逆变换,ur()、ui()-输入、输出数据
    Dim i As Integer, j As Integer
    If z Then                                   '改变原函数符号，用于频谱图像移到中心
        For i = 0 To 255: For j = 0 To 255
            If ((i + j) Mod 2) <> 0 Then
                ur(i, j) = -ur(i, j): ui(i, j) = -ui(i, j)
            End If
        Next j: Next i
    End If
    For i = 0 To 255                                            'Y方向变换
        For j = 0 To 255
            xr(j) = ur(i, j): xi(j) = ui(i, j)
        Next j
        Call fft(z)
        For j = 0 To 255
            ur(i, j) = xr(j): ui(i, j) = xi(j)
        Next j
    Next i
    For j = 0 To 255                                            'X方向变换
        For i = 0 To 255
            xr(i) = ur(i, j): xi(i) = ui(i, j)
        Next i
        Call fft(z)
        For i = 0 To 255
            ur(i, j) = xr(i): ui(i, j) = xi(i)
        Next i
    Next j
End Sub

Private Sub picshow(ByVal b As Boolean, p As PictureBox)        '图像显示子程序
    Dim max As Single, min As Single                            '函数最大、小值
    Dim x(255, 255) As Single
    Dim i As Integer, j As Integer, c As Single
    max = -1E+30: min = 1E+30
    For i = 0 To 255: For j = 0 To 255
        c = Sqr(ur(i, j) * ur(i, j) + ui(i, j) * ui(i, j))
        c = IIf(b, Log(1 + c), c): x(i, j) = c
        If c > max Then max = c
        If c < min Then min = c
    Next j: Next i
    If max - min = 0 Then max = 0 Else max = 255 / (max - min)
    For i = 0 To 255: For j = 0 To 255
        c = max * (x(i, j) - min)
        p.PSet (i, j), RGB(c, c, c)
    Next j: Next i
End Sub

Private Sub Command2_Click()                                    '添加噪声
    Dim i As Integer, j As Integer, c As Integer
    For i = 0 To 5000
        c = 255 * Rnd
        Picture1.PSet (255 * Rnd, 255 * Rnd), RGB(c, c, c)
    Next i
    For i = 0 To 255: For j = 0 To 255
        f(i, j) = Picture1.Point(i, j) & 255
        ur(i, j) = f(i, j): ui(i, j) = 0
    Next j: Next i
    Call xxx1
End Sub

Private Sub Form_Load()
    Me.Show: Refresh: Call HScroll1_Change
End Sub

Private Sub HScroll2_Change(Index As Integer)                   '平移原始图
    Dim i As Integer, j As Integer, i1 As Integer, j1 As Integer
    For i = 0 To 255: For j = 0 To 255
        i1 = i - HScroll2(1).Value: j1 = j - HScroll2(2).Value
        If i1 < 0 Then
            i1 = i1 + 255
        ElseIf i1 > 255 Then
            i1 = i1 - 255
        End If
        If j1 < 0 Then
            j1 = j1 + 255
        ElseIf j1 > 255 Then
            j1 = j1 - 255
        End If
        ur(i, j) = f(i1, j1): ui(i, j) = 0
    Next j: Next i
    Call xxx1
End Sub

Private Sub HScroll1_Change()                                   '显示原图函数
    Dim i As Integer, j As Integer, c As Single                 '定义变量
    c = HScroll1.Value                                          '取函数宽度
    For i = 0 To 255: For j = 0 To 255                          '函数清零
        f(i, j) = 0
    Next j: Next i
    If Option1(0).Value Then                                    '方孔图像
        For i = 0 To 255: For j = 0 To 255
            f(i, j) = IIf(Abs(i - 127) < c And Abs(j - 127) < c, 1, 0)
        Next j: Next i
    ElseIf Option1(1).Value Then                                '网格图像
        For i = 0 To 255: For j = 0 To 255
                If (i Mod c) = 0 Then f(i, j) = 1: f(j, i) = 1
        Next j: Next i
    ElseIf Option1(2).Value Then                                '单缝图像
        For i = 0 To 255: For j = 0 To 255
            f(i, j) = IIf(Abs(i - 127) < c, 1, 0)
        Next j: Next i
    ElseIf Option1(3).Value Then                                '棋盘图像
        For i = 0 To 255: For j = 0 To 255
            f(i, j) = 0.5 * ((-1) ^ (i \ c + j \ c) + 1)
        Next j: Next i
    ElseIf Option1(4).Value Then                                '条形图像
        c = 1: i = 0
        Do
            For j = 0 To 255
                f(i, j) = 1
            Next j
            c = c + 1: i = i + c
        Loop Until i > 255
    ElseIf Option1(5).Value Then                                '单点图像
        f(127, 127) = 1
    ElseIf Option1(6).Value Then                                '正弦图像
        For i = 0 To 255: For j = 0 To 255
            f(i, j) = Sin(0.01 * c * i)
        Next j: Next i
    End If
    For i = 0 To 255: For j = 0 To 255
        ur(i, j) = f(i, j): ui(i, j) = 0
    Next j: Next i
    Call xxx1
End Sub

Private Sub HScroll3_Change()                                   '旋转图像
    Dim i As Integer, j As Integer, i1 As Integer, j1 As Integer
    Dim st As Single, cosst As Single, sinst As Single
    st = HScroll3.Value * Atn(1) / 45
    cosst = Cos(st): sinst = Sin(st)
    For i = 0 To 255: For j = 0 To 255
        
        
        i1 = (i - 127) * cosst + (j - 127) * sinst + 127
        j1 = -(i - 127) * sinst + (j - 127) * cosst + 127
        If i1 < 0 Or i1 > 255 Or j1 < 0 Or j1 > 255 Then ur(i, j) = 0 Else ur(i, j) = f(i1, j1)
        ui(i, j) = 0
    Next j: Next i
    Call xxx1
End Sub

Private Sub xxx1()                          '显示原图，傅立叶变换，显示频谱
    Dim i As Integer, j As Integer
    Call picshow(False, Picture1)
    Call fft2(True)
    Call picshow(True, Picture2)
    For i = 0 To 255: For j = 0 To 255
        pr(i, j) = ur(i, j): pi(i, j) = ui(i, j)
    Next j: Next i
    Call xxx2
End Sub

Private Sub xxx2()
    Dim i As Integer, j As Integer, d0 As Integer, n As Integer
    Dim d As Single, lb(255, 255) As Single
    d0 = HScroll4.Value: n = HScroll5.Value
    For i = 0 To 255: For j = 0 To 255
        d = Sqr((i - 127#) * (i - 127#) + (j - 127#) * (j - 127#))
        If Optlb(0).Value And Optlb(5).Value Then       '低通理想滤波器
            lb(i, j) = IIf(d < d0, 1, 0)
        ElseIf Optlb(0).Value And Optlb(4).Value Then   '高通理想滤波器
            lb(i, j) = IIf(d < d0, 0, 1)
        ElseIf Optlb(1).Value And Optlb(5).Value Then   '低通巴特沃兹滤波器
            lb(i, j) = 1 / (1 + d / d0) ^ (n + n)
        ElseIf Optlb(1).Value And Optlb(4).Value Then   '高通巴特沃兹滤波器
            If d = 0 Then lb(i, j) = 0 Else lb(i, j) = 1 / (1 + d0 / d) ^ (n + n)
        ElseIf Optlb(2).Value And Optlb(5).Value Then   '低通指数滤波器
            lb(i, j) = Exp(-(d / d0) ^ n)
        ElseIf Optlb(2).Value And Optlb(4).Value Then   '高通指数滤波器
            If d = 0 Then lb(i, j) = 0 Else lb(i, j) = Exp(-(d0 / d) ^ n)
        ElseIf Optlb(3).Value And Optlb(5).Value Then   '低通梯形滤波器
            lb(i, j) = IIf(d < d0, 1, (d - 180) / (d0 - 180))
        ElseIf Optlb(3).Value And Optlb(4).Value Then   '高通梯形滤波器
            If d < d0 Then
                lb(i, j) = 0
            ElseIf d > 127 Then
                lb(i, j) = 1
            Else
                lb(i, j) = (d - d0) / (127 - d0)
            End If
        ElseIf Optlb(6).Value And Optlb(5).Value Then   '低通水平滤波器
            lb(i, j) = IIf(Abs(i - 127) < d0, 1, 0)
        ElseIf Optlb(6).Value And Optlb(4).Value Then   '高通水平滤波器
            lb(i, j) = IIf(Abs(i - 127) < d0, 0, 1)
        ElseIf Optlb(7).Value And Optlb(5).Value Then   '低通垂直滤波器
            lb(i, j) = IIf(Abs(j - 127) < d0, 1, 0)
        ElseIf Optlb(7).Value And Optlb(4).Value Then   '低通垂直滤波器
            lb(i, j) = IIf(Abs(j - 127) < d0, 0, 1)
        ElseIf Optlb(8).Value Then                      '正弦光栅
            lb(i, j) = Sin(0.01 * d0 * i) * Sin(0.01 * d0 * j)
        End If
    Next j: Next i
    For i = 0 To 255: For j = 0 To 255
        ur(i, j) = lb(i, j): ui(i, j) = 0
    Next j: Next i
    Call picshow(False, Picture3)                       '显示滤波器
    For i = 0 To 255: For j = 0 To 255                  '滤波
        ur(i, j) = pr(i, j) * lb(i, j)
        ui(i, j) = pi(i, j) * lb(i, j)
    Next j: Next i
    Call fft2(False)
    Call picshow(False, Picture4)
End Sub

Private Sub Option2_Click()                             '调入图像
'    On Error Resume Next
'    Dim i As Integer, j As Integer
'    CommonDialog1.CancelError = True
 '   CommonDialog1.Flags = cdlOFNHideReadOnly
 '   CommonDialog1.Filter = "All Files (*.*)|*.*|Bmp Files(*.bmp)|*.bmp"
 '   CommonDialog1.FilterIndex = 1
 '   CommonDialog1.ShowOpen
 '   Picture1.Picture = LoadPicture(CommonDialog1.FileName)
 '   For i = 0 To 255: For j = 0 To 255
 '       ur(i, j) = Picture1.Point(i, j) & 255
 '       f(i, j) = ur(i, j): ui(i, j) = 0
 '   Next j: Next i
 '   Call xxx1
End Sub

Private Sub Option1_Click(Index As Integer)
    Call HScroll1_Change
End Sub

Private Sub Optlb_Click(Index As Integer)
    Call xxx2
End Sub

Private Sub HScroll4_Change()
    Call xxx2
End Sub

Private Sub HScroll5_Change()
    Call xxx2
End Sub