计算机控制课程设计.bas

来自「基于单片机的数据采集系统 完成数据采集并对采集的数据进行时频域分析 软硬结」· BAS 代码 · 共 192 行

Attribute VB_Name = "Module1"
Public n As Integer
Public nn As Integer '波形显示周期调节系数
Public data(2100) As Single
Public Interval, frequency As Single                   '采样频率

Public data2(2100) As Double                           'FFT数组
Public Pi As Double
'绘FFT图时的数学转换程序

Public Sub Rdft(n As Integer, wr As Double, wi As Double, a() As Double) '傅利叶快速变换
Dim j As Integer, k As Integer
Dim wkr As Double, wdr As Double, wdi As Double, ss As Double, xr As Double, xi As Double, yr As Double, yi As Double
    If (n > 4) Then
        wkr = 0
        wki = 0
        wdr = wi * wi
        wdi = wi * wr
        ss = 4 * wdi
        wr = 1 - 2 * wdr
        wi = 2 * wdi
        If (wi >= 0) Then
            Call Cdft(n, wr, wi, a)
            xi = a(0) - a(1)
            a(0) = a(0) + a(1)
            a(1) = xi
        End If
        For k = (n / 2) - 4 To 4 Step -4
            j = n - k
            xr = a(k + 2) - a(j - 2)
            xi = a(k + 3) + a(j - 1)
            yr = wdr * xr - wdi * xi
            yi = wdr * xi + wdi * xr
            a(k + 2) = a(k + 2) - yr
            a(k + 3) = a(k + 3) - yi
            a(j - 2) = a(j - 2) + yr
            a(j - 1) = a(j - 1) - yi
            wkr = wkr + ss * wdi
            wki = wki + ss * (0.5 - wdr)
            xr = a(k) - a(j)
            xi = a(k + 1) + a(j + 1)
            yr = wkr * xr - wki * xi
            yi = wkr * xi + wki * xr
            a(k) = a(k) - yr
            a(k + 1) = a(k + 1) - yi
            a(j) = a(j) + yr
            a(j + 1) = a(j + 1) - yi
            wdr = wdr + ss * wki
            wdi = wdi + ss * (0.5 - wkr)
        Next
        j = n - 2
        xr = a(2) - a(j)
        xi = a(3) + a(j + 1)
        yr = wdr * xr - wdi * xi
        yi = wdr * xi + wdi * xr
        a(2) = a(2) - yr
        a(3) = a(3) - yi
        a(j) = a(j) + yr
        a(j + 1) = a(j + 1) - yi
        If (wi < 0) Then
            a(1) = 0.5 * (a(0) - a(1))
            a(0) = a(0) - a(1)
            Call Cdft(n, wr, wi, a)
        End If
    Else
        If (wi < 0) Then
            a(1) = 0.5 * (a(0) - a(1))
            a(0) = a(0) - a(1)
        End If
        If (n > 2) Then
            xr = a(0) - a(2)
            xi = a(1) - a(3)
            a(0) = a(0) + a(2)
            a(1) = a(1) + a(3)
            a(2) = xr
            a(3) = xi
        End If
        If (wi >= 0) Then
            xi = a(0) - a(1)
            a(0) = a(0) + a(1)
            a(1) = xi
        End If
    End If

End Sub

Public Sub Cdft(n As Integer, wr As Double, wi As Double, a() As Double)
Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer
Dim wkr As Double, wki As Double, wdr As Double, wdi As Double, ss As Double, xr As Double, xi As Double
    m = n
    While (m > 4)
        l = m / 2
        wkr = 1
        wki = 0
        wdr = 1 - 2 * wi * wi
        wdi = 2 * wi * wr
        ss = 2 * wdi
        wr = wdr
        wi = wdi
        For j = 0 To n - m Step m
            i = j + l
            xr = a(j) - a(i)
            xi = a(j + 1) - a(i + 1)
            a(j) = a(j) + a(i)
            a(j + 1) = a(j + 1) + a(i + 1)
            a(i) = xr
            a(i + 1) = xi
            xr = a(j + 2) - a(i + 2)
            xi = a(j + 3) - a(i + 3)
            a(j + 2) = a(j + 2) + a(i + 2)
            a(j + 3) = a(j + 3) + a(i + 3)
            a(i + 2) = wdr * xr - wdi * xi
            a(i + 3) = wdr * xi + wdi * xr
        Next
        For k = 4 To l - 4 Step 4
            wkr = wkr - ss * wdi
            wki = wki + ss * wdr
            wdr = wdr - ss * wki
            wdi = wdi + ss * wkr
            For j = k To n - m + k Step m
                i = j + l
                xr = a(j) - a(i)
                xi = a(j + 1) - a(i + 1)
                a(j) = a(j) + a(i)
                a(j + 1) = a(j + 1) + a(i + 1)
                a(i) = wkr * xr - wki * xi
                a(i + 1) = wkr * xi + wki * xr
                xr = a(j + 2) - a(i + 2)
                xi = a(j + 3) - a(i + 3)
                a(j + 2) = a(j + 2) + a(i + 2)
                a(j + 3) = a(j + 3) + a(i + 3)
                a(i + 2) = wdr * xr - wdi * xi
                a(i + 3) = wdr * xi + wdi * xr
            Next
        Next
        m = l
    Wend
    If (m > 2) Then
        For j = 0 To n - 4 Step 4
            xr = a(j) - a(j + 2)
            xi = a(j + 1) - a(j + 3)
            a(j) = a(j) + a(j + 2)
            a(j + 1) = a(j + 1) + a(j + 3)
            a(j + 2) = xr
            a(j + 3) = xi
        Next
    End If
    If (n > 4) Then
        Call Bitrv2(n, a)
    End If
End Sub

Public Sub Bitrv2(n As Integer, a() As Double)
Dim j As Integer, j1 As Integer, k As Integer, kl As Integer, l As Integer, m As Integer, m2 As Integer, n2 As Integer
    m = n / 4
    m2 = m * 2
    n2 = n - 2
    k = 0
    For j = 0 To m2 - 4 Step 4
        If (j < k) Then
            xr = a(j)
            xi = a(j + 1)
            a(j) = a(k)
            a(j + 1) = a(k + 1)
            a(k) = xr
            a(k + 1) = xi
        ElseIf (j > k) Then
            j1 = n2 - j
            k1 = n2 - k
            xr = a(j1)
            xi = a(j1 + 1)
            a(j1) = a(k1)
            a(j1 + 1) = a(k1 + 1)
            a(k1) = xr
            a(k1 + 1) = xi
        End If
        k1 = m2 + k
        xr = a(j + 2)
        xi = a(j + 3)
        a(j + 2) = a(k1)
        a(j + 3) = a(k1 + 1)
        a(k1) = xr
        a(k1 + 1) = xi
        l = m
        While (k >= l)
            k = k - l
            l = l / 2
        Wend
        k = k + l
    Next
End Sub