module1.bas

频谱分析程序,基于离散傅里叶变换的频谱分析程序。由时间序列求出在频域里的振幅图象

Attribute VB_Name = "Module1"
Option Base 1

Public XX() As Double, YY() As Double, ZZ() As Double
Public XX1() As Double, YY1() As Double, ZZ1() As Double
Public XX2() As Double, YY2() As Double, ZZ2() As Double

Public Const Pi As Double = 3.14159265


Public ObjMatlab As Object, Result As String

'********************
Public REX_XX() As Double
Public IMX_XX() As Double
Public REX_YY() As Double
Public IMX_YY() As Double
Public REX_ZZ() As Double
Public IMX_ZZ() As Double
'********************
Public g_SignalFile As String
Public Points_Num As Long
Public Sample_HZ As Integer
'********************
Public Frekans_XX() As Double
Public Frekans_YY() As Double
Public Frekans_ZZ() As Double
'********************
Public Min As Double
Public Max As Double
Public MStep As Double
Sub DFT()
    Dim i As Long, k As Long
    Dim C As Long, j As Long
    C = Points_Num
    ReDim Preserve REX_XX(C)
    ReDim Preserve IMX_XX(C)
    ReDim Preserve REX_YY(C)
    ReDim Preserve IMX_YY(C)
    ReDim Preserve REX_ZZ(C)
    ReDim Preserve IMX_ZZ(C)
    ReDim Preserve Frekans_XX(C)
    ReDim Preserve Frekans_YY(C)
    ReDim Preserve Frekans_ZZ(C)
    
    
    For k = 1 To C / 2
        For i = 0 To C - 1
            
            REX_XX(k) = REX_XX(k) + XX2(i + 1) * Cos(2 * Pi * k * i / Points_Num) * 2 / C
            IMX_XX(k) = IMX_XX(k) + XX2(i + 1) * Sin(2 * Pi * k * i / Points_Num) * 2 / C
            
            
         REX_YY(k) = REX_YY(k) + YY2(i + 1) * Cos(2 * Pi * k * i / Points_Num) * 2 / C
            IMX_YY(k) = IMX_YY(k) + YY2(i + 1) * Sin(2 * Pi * k * i / Points_Num) * 2 / C
            
            REX_ZZ(k) = REX_ZZ(k) + ZZ2(i + 1) * Cos(2 * Pi * k * i / Points_Num) * 2 / C
            IMX_ZZ(k) = IMX_ZZ(k) + ZZ2(i + 1) * Sin(2 * Pi * k * i / Points_Num) * 2 / C
            
        Next i
   
            Frekans_XX(k) = Sqr(REX_XX(k) ^ 2 + IMX_XX(k) ^ 2)
            
            Frekans_YY(k) = Sqr(REX_YY(k) ^ 2 + IMX_YY(k) ^ 2)
            
            Frekans_ZZ(k) = Sqr(REX_ZZ(k) ^ 2 + IMX_ZZ(k) ^ 2)
            
            Form1.ProgressBar1.Value = Int(100 * k / C * 2)
            Form1.StatusBar1.Panels(1).Text = "计算中"
            
            
            
    Next k
        Form1.StatusBar1.Panels(1).Text = "频谱计算已完成"
        Form1.StatusBar1.Refresh
        Form1.ProgressBar1.Value = 0
  
End Sub



Sub FFT_FT(Min As Double, Max As Double, MStep As Double, n As Integer, jhHZ() As Double)
    Dim i As Long, j As Long, k As Long
    k = (Max - Min) / MStep + 1
    
    For i = 1 To Points_Num
        Sumx = Sumx + XX2(i)
        Sumy = Sumy + YY2(i)
        Sumz = Sumz + ZZ2(i)
    Next i
    Meanx = Sumx / Points_Num
    Meany = Sumy / Points_Num
    Meanz = Sumz / Points_Num
    


    ReDim jhHZ(k, 1 To 2)
    Select Case n
        Case 0

            For i = 1 To k
                jhHZ(i, 1) = Min + MStep * (i - 1)
                For j = 0 To Points_Num - 1
                    a = a + (XX2(j + 1) - Meanx) * Cos(2 * j * Pi * jhHZ(i, 1) / Sample_HZ) * 2 / Points_Num
                    b = b + (XX2(j + 1) - Meanx) * Sin(2 * j * Pi * jhHZ(i, 1) / Sample_HZ) * 2 / Points_Num
                Next j
                jhHZ(i, 2) = Sqr(a ^ 2 + b ^ 2)
                a = 0
                b = 0
                Form1.ProgressBar1.Value = i * 100 / k
            Next i
        Case 1
            For i = 1 To k
                jhHZ(i, 1) = Min + MStep * (i - 1)
                For j = 0 To Points_Num - 1
                    a = a + (YY2(j + 1) - Meany) * Cos(2 * j * Pi * jhHZ(i, 1) / Sample_HZ) * 2 / Points_Num
                    b = b + (YY2(j + 1) - Meany) * Sin(2 * j * Pi * jhHZ(i, 1) / Sample_HZ) * 2 / Points_Num
                Next j
                jhHZ(i, 2) = Sqr(a ^ 2 + b ^ 2)
                a = 0
                b = 0
                Form1.ProgressBar1.Value = i * 100 / k
            Next i
        Case 2
            For i = 1 To k
                jhHZ(i, 1) = Min + MStep * (i - 1)
                For j = 0 To Points_Num - 1
                    a = a + (YY2(j + 1) - Meany) * Cos(2 * j * Pi * jhHZ(i, 1) / Sample_HZ) * 2 / Points_Num
                    b = b + (YY2(j + 1) - Meany) * Sin(2 * j * Pi * jhHZ(i, 1) / Sample_HZ) * 2 / Points_Num
                Next j
                jhHZ(i, 2) = Sqr(a ^ 2 + b ^ 2)
                a = 0
                b = 0
                Form1.ProgressBar1.Value = i * 100 / k
            Next i
    End Select
    
    
    
    
    
    
    
'  Dim ChartArray1() As Double, ChartArray2() As Double, ChartArray3() As Double, Img() As Double
''        ReDim ChartArray1(k, 1 To 2)
'        ReDim ChartArray2(k, 1 To 2)
'        ReDim ChartArray3(k, 1 To 2)
'
'        Dim Sumx As Double, Meanx As Double, Sumy As Double, Meany As Double, Sumz As Double, Meanz As Double
'        For i = 1 To Points_Num
'            Sumx = Sumx + XX2(i)
'            Sumy = Sumy + YY2(i)
'            Sumz = Sumz + ZZ2(i)
'        Next i
'        Meanx = Sumx / Points_Num
'        Meany = Sumy / Points_Num
'        Meanz = Sumz / Points_Num
'
'        For i = 1 To k
'                ChartArray1(i, 1) = Min + MStep * (i - 1)
'            For j = 0 To Points_Num - 1
'                a = a + (XX2(j + 1) - Meanx) * Cos(2 * j * Pi * (ChartArray1(i, 1)) / Sample_HZ) * 2 / Points_Num
'                b = b + (XX2(j + 1) - Meanx) * Sin(2 * j * Pi * (ChartArray1(i, 1)) / Sample_HZ) * 2 / Points_Num
'
'
'            Next j
'                ChartArray1(i, 2) = Sqr(a ^ 2 + b ^ 2)
'                a = 0
'                b = 0
'                Form1.ProgressBar1.Value = i * 100 / k
'        Next i
'
'
'
'        For i = 1 To k
'                ChartArray2(i, 1) = Min + MStep * (i - 1)
'            For j = 0 To Points_Num - 1
'                a = a + (YY2(j + 1) - Meany) * Cos(2 * j * Pi * (ChartArray1(i, 1)) / Sample_HZ) * 2 / Points_Num
'                b = b + (YY2(j + 1) - Meany) * Sin(2 * j * Pi * (ChartArray1(i, 1)) / Sample_HZ) * 2 / Points_Num
'            Next j
'                ChartArray2(i, 2) = Sqr(a ^ 2 + b ^ 2)
'                a = 0
'                b = 0
'                Form1.ProgressBar1.Value = i * 100 / k
'        Next i
'
'
'        For i = 1 To k
'                ChartArray3(i, 1) = Min + MStep * (i - 1)
'            For j = 0 To Points_Num - 1
'                a = a + (ZZ2(j + 1) - Meanz) * Cos(2 * j * Pi * (ChartArray1(i, 1)) / Sample_HZ) * 2 / Points_Num
'                b = b + (ZZ2(j + 1) - Meanz) * Sin(2 * j * Pi * (ChartArray1(i, 1)) / Sample_HZ) * 2 / Points_Num
'            Next j
'                ChartArray3(i, 2) = Sqr(a ^ 2 + b ^ 2)
'                a = 0
'                b = 0
'                Form1.ProgressBar1.Value = i * 100 / k
'        Next i
        
         
        
        
        
        
        

'    Call ObjMatlab.PutFullMatrix("x", "base", ChartArray1, Img)
'    Call ObjMatlab.PutFullMatrix("y", "base", ChartArray2, Img)
'    Call ObjMatlab.PutFullMatrix("z", "base", ChartArray3, Img)
'
'    ObjMatlab.Execute ("subplot(3,1,1);plot(x(:,1),x(:,2));grid on")
'    ObjMatlab.Execute ("subplot(3,1,2);plot(y(:,1),y(:,2));grid on")
'    ObjMatlab.Execute ("subplot(3,1,3);plot(z(:,1),z(:,2));grid on")
'
'
'
'
'
'
    
    
    
'
'    Close #2
'
    
    
    
    
        
        
End Sub


Sub Dect1(Matrix() As Double, lablXX() As Double)



    Dim Img() As Double
    Dim ss As String, i As Integer, j As Double
    Dim Nnum1(1, 1) As Double
    Dim bool As Boolean
    
    Call ObjMatlab.PutFullMatrix("xx", "base", Matrix, Img)
    
    ObjMatlab.Execute ("XX_num = length(xx');")
    ObjMatlab.Execute ("[cA1,cD1] = dwt(xx','db1');")
    ObjMatlab.Execute ("D1 = upcoef('d',cD1,'db1',1,XX_num );")
    ObjMatlab.Execute ("sigma=std(D1);smean=mean(D1);")
    ObjMatlab.Execute ("n1=find(abs((D1-smean))>sigma*3);")
    ObjMatlab.Execute ("num1=length(n1);")
    Call ObjMatlab.GetFullMatrix("num1", "base", Nnum1, Img)
    ReDim Preserve lablXX(1 To Nnum1(1, 1))
     Call ObjMatlab.GetFullMatrix("n1", "base", lablXX, Img)
     
     
     
        

End Sub

Sub DFT_Show()
    Dim i As Integer, k As Long, ChartArray2() As Double
    Dim Img() As Double
    k = Int(Points_Num / 2) + 1

    ReDim ChartArray2(Points_Num / 2, 1 To 2)
    Select Case Form1.Combo1.ListIndex
        Case 0

            For i = 1 To Points_Num / 2
                ChartArray2(i, 1) = i * Sample_HZ / Points_Num
                ChartArray2(i, 2) = Frekans_XX(i)
            Next i
        Case 1
            For i = 1 To Points_Num / 2
                ChartArray2(i, 1) = i * Sample_HZ / Points_Num
                ChartArray2(i, 2) = Frekans_YY(i)
            Next i
        Case 2
            For i = 1 To Points_Num / 2
                ChartArray2(i, 1) = i * Sample_HZ / Points_Num
                ChartArray2(i, 2) = Frekans_ZZ(i)
            Next i

    End Select

    Call ObjMatlab.PutFullMatrix("a", "base", ChartArray2, Img)
    ObjMatlab.Execute ("plot(a(:,1),a(:,2));grid on")




'
'   Dim ChartArray1() As Double, ChartArray2() As Double, ChartArray3() As Double, k As Integer, Img() As Double
'        ReDim ChartArray1(Points_Num / 2, 1 To 2)
'        ReDim ChartArray2(Points_Num / 2, 1 To 2)
'        ReDim ChartArray3(Points_Num / 2, 1 To 2)
'
'        For i = 1 To Points_Num / 2
'                ChartArray1(i, 1) = i * Sample_HZ / Points_Num
'                ChartArray1(i, 2) = Frekans_XX(i)
'
'
'                ChartArray2(i, 1) = i * Sample_HZ / Points_Num
'                ChartArray2(i, 2) = Frekans_YY(i)
'
'                ChartArray3(i, 1) = i * Sample_HZ / Points_Num
'                ChartArray3(i, 2) = Frekans_ZZ(i)
'
'
'
'
'        Next i
'
'
'
'
'    Call ObjMatlab.PutFullMatrix("x", "base", ChartArray1, Img)
'    Call ObjMatlab.PutFullMatrix("y", "base", ChartArray2, Img)
'    Call ObjMatlab.PutFullMatrix("z", "base", ChartArray3, Img)
'
'    ObjMatlab.Execute ("subplot(3,1,1);plot(x(:,1),x(:,2));grid on")
'    ObjMatlab.Execute ("subplot(3,1,2);plot(y(:,1),y(:,2));grid on")
'    ObjMatlab.Execute ("subplot(3,1,3);plot(z(:,1),z(:,2));grid on")
'''
'''
''''
''




























End Sub