form1.frm

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

    On Error Resume Next
    CommonDialog1.CancelError = True
    CommonDialog1.Flags = cdlOFNHideReadOnly
    CommonDialog1.Filter = " 文本文档(*.txt)|*.txt"
    CommonDialog1.FilterIndex = 1
    CommonDialog1.ShowOpen
    g_SignalFile = CommonDialog1.FileName
    FileNumber = FreeFile
    StatusBar1.Panels(1).Text = "数据加载中"
    StatusBar1.Refresh
    Open g_SignalFile For Input As #FileNumber
            n = 0
            Do
            Line Input #FileNumber, ss
            ssArray = Split(Trim(ss))
            If UBound(ssArray) > 9 Then
                If CBool(ssArray(1) = "GPS") And CBool(ssArray(2) = "PT.") Then
                
                    n = n + 1
                    ReDim Preserve XX(n), YY(n), ZZ(n)
                    XX(n) = CDbl(ssArray(3))
                    YY(n) = CDbl(ssArray(4))
                    ZZ(n) = CDbl(ssArray(5))
                 End If
            End If
            
             
            Loop While Not EOF(FileNumber)
        Close #FileNumber
             
             Points_Num = n
            For i = 1 To Points_Num
            
                Grid1.AddItem Str(i)
                Grid1.Col = 1
                Grid1.Row = i
                Grid1.Text = XX(i)
                
                Grid1.Col = 2
                Grid1.Row = n
                Grid1.Text = YY(i)
                
                Grid1.Col = 3
                Grid1.Row = i
                Grid1.Text = ZZ(i)
                ProgressBar1.Value = i * 100 / Points_Num
            Next i
            MsgBox n, , "Number of Data"
            
           
   
            StatusBar1.Panels(1).Text = "已加载完数据"
            StatusBar1.Panels(3).Text = g_SignalFile
            StatusBar1.Refresh
            
            
            Dect.Enabled = True

End Sub
Private Sub Command1_Click()
    Dim k As Long, Max As Double, Min As Double, i As Long, ChartArray1() As Double
    ReDim ChartArray1(Points_Num, 1 To 2)
    Dim Real() As Double, Img() As Double
    
    
    Select Case Combo1.ListIndex
        Case 0
            
            For k = 1 To Points_Num
                ChartArray1(k, 1) = k
                ChartArray1(k, 2) = XX(k)
            Next k
        Case 1
        
            For k = 1 To Points_Num
                ChartArray1(k, 1) = k
                ChartArray1(k, 2) = YY(k)
            Next k
         Case 2
            For k = 1 To Points_Num
                ChartArray1(k, 1) = k
                ChartArray1(k, 2) = ZZ(k)
            Next k
                 
    End Select
    Call ObjMatlab.PutFullMatrix("a", "base", ChartArray1, Img)
    ObjMatlab.Execute ("plot(a(:,1),a(:,2)));grid on")
    
End Sub



Private Sub Command2_Click()
    Call DFT_Show
End Sub

Private Sub Command4_Click()
    End
End Sub

Private Sub Command3_Click()
    Dim Img() As Double, jhFrekans() As Double
    
    Call FFT_FT(Min, Max, MStep, Combo1.ListIndex, jhFrekans)
    Call ObjMatlab.PutFullMatrix("b", "base", jhFrekans, Img)
    ObjMatlab.Execute ("plot(b(:,1),b(:,2));grid on")
'
End Sub

Private Sub Dect_Click()
    Dim lablXX() As Double, LablYY() As Double, LablZZ() As Double
    Dim ss As String, i As Integer, j As Double
    Dim bool As Boolean
    Dim Img() As Double


' 探测粗差
    'X轴方向
    Call Dect1(XX, lablXX)
    
    Text1.Text = Text1.Text & "X方向可能含有粗差的历元" & Chr(13) & Chr(10)
    For i = 1 To UBound(lablXX)
        Text1.Text = Text1.Text & "     " & lablXX(i)
        Grid1.Row = lablXX(i)
        Grid1.Col = 1
        Grid1.CellBackColor = vbRed
    Next i
    Text1.Text = Text1.Text & Chr(13) & Chr(10)
    
    ReDim Preserve XX1(1 To Points_Num)
    For i = 1 To Points_Num
        bool = False
        For j = 1 To UBound(lablXX)
            If i = lablXX(j) Then
                bool = True
                Exit For
            End If
        Next j
        If bool = True Then
            XX1(i) = 2 * XX1(i - 1) - XX1(i - 2)
        Else
            XX1(i) = XX(i)
        End If
        
    Next i

      'Y轴方向
    
    Call Dect1(YY, LablYY)
    
    Text1.Text = Text1.Text & "Y方向可能含有粗差的历元" & Chr(13) & Chr(10)
    
    For i = 1 To UBound(LablYY)
        Text1.Text = Text1.Text & "     " & LablYY(i)
        Grid1.Row = LablYY(i)
        Grid1.Col = 2
        Grid1.CellBackColor = vbRed
    Next i
    Text1.Text = Text1.Text & Chr(13) & Chr(10)
    
    
    ReDim Preserve YY1(1 To Points_Num)
    For i = 1 To Points_Num
        bool = False
        For j = 1 To UBound(LablYY)
            If i = LablYY(j) Then
                bool = True
                Exit For
            End If
        Next j
        If bool = True Then
            YY1(i) = 2 * YY1(i - 1) - YY1(i - 2)
        Else
             YY1(i) = YY(i)
        End If
    Next i
    
      'Z轴方向
    
    Call Dect1(ZZ, LablZZ)
    
    Text1.Text = Text1.Text & "Z方向可能含有粗差的历元" & Chr(13) & Chr(10)
    For i = 1 To UBound(LablZZ)
        Text1.Text = Text1.Text & "     " & LablZZ(i)
        Grid1.Row = LablZZ(i)
        Grid1.Col = 3
        Grid1.CellBackColor = vbRed
    Next i
    
    
    
    ReDim Preserve ZZ1(1 To Points_Num)
    For i = 1 To Points_Num
        bool = False
        For j = 1 To UBound(LablZZ)
            If i = LablZZ(j) Then
                bool = True
                Exit For
            End If
        Next j
        If bool = True Then
           ZZ1(i) = 2 * ZZ1(i - 1) - ZZ1(i - 2)
        Else
             ZZ1(i) = ZZ(i)
        End If
    Next i
    
    StatusBar1.Panels(1).Text = "已探测完粗差"
    StatusBar1.Refresh
     MnuDenoise.Enabled = True
End Sub

Private Sub Exit_Click()
    Set ObjMatlab = Nothing
    End
End Sub

Private Sub ExitTask_Click()
    Dim i As Long
    g_SignalFile = ""
    For i = 1 To Points_Num
        XX(i) = 0
        YY(i) = 0
        ZZ(i) = 0
        XX1(i) = 0
        YY1(i) = 0
        ZZ1(i) = 0
        XX2(i) = 0
        YY2(i) = 0
        ZZ2(i) = 0
    Next i
    Grid1.Clear
    Grid1.Rows = 1
    Grid1.Col = 0
    Grid1.Row = 0
    Grid1.Text = "序号"
    Grid1.Col = 1
    Grid1.Row = 0
    Grid1.Text = "X坐标"
    Grid1.Col = 2
    Grid1.Row = 0
    Grid1.Text = "Y坐标"
    Grid1.Col = 3
    Grid1.Row = 0
    Grid1.Text = "Z坐标"
End Sub

Private Sub Form_Load()
    Grid1.ColWidth(0) = 600
    Grid1.ColWidth(1) = 1400
    Grid1.ColWidth(2) = 1400
    Grid1.ColWidth(3) = 1200
    Grid1.Col = 0
    Grid1.Row = 0
    Grid1.Text = "序号"
    Grid1.Col = 1
    Grid1.Row = 0
    Grid1.Text = "X坐标"
    Grid1.Col = 2
    Grid1.Row = 0
    Grid1.Text = "Y坐标"
    Grid1.Col = 3
    Grid1.Row = 0
    Grid1.Text = "Z坐标"
    Combo1.ListIndex = 0
    
  
    Command1.Enabled = False
    Command2.Enabled = False
    Command3.Enabled = False
    
    StatusBar1.Width = Form1.Width
    ProgressBar1.Top = StatusBar1.Top + 15
    ProgressBar1.Height = StatusBar1.Height - 30
    ProgressBar1.Width = StatusBar1.Panels(2).Width - 20
    ProgressBar1.Left = StatusBar1.Left + StatusBar1.Panels(1).Width + 10
    
    
    Set ObjMatlab = CreateObject("Matlab.Application")
    ObjMatlab.Visible = False
    
    Dect.Enabled = False
    MnuDenoise.Enabled = False
    MCOU_HZ.Enabled = False
        
End Sub



Private Sub Form_Unload(Cancel As Integer)
    End
End Sub


Private Sub IntrestTxt_Change(Index As Integer)
    
    Min = CDbl(Val(IntrestTxt(0).Text))
    Max = CDbl(Val(IntrestTxt(1).Text))
    MStep = CDbl(Val(IntrestTxt(2).Text))
    Command3.Enabled = True

End Sub

Private Sub MCOU_HZ_Click()
    Call DFT
End Sub

Private Sub MnuDenoise_Click()
    Dim Img() As Double
    
    Call ObjMatlab.PutFullMatrix("nx", "base", XX1, Img)
    ObjMatlab.Execute ("xd=wden(nx,'sqtwolog','s','mln',4,'db5');")
    ReDim Preserve XX2(1 To Points_Num)
    Call ObjMatlab.GetFullMatrix("xd", "base", XX2, Img)
    
    Call ObjMatlab.PutFullMatrix("ny", "base", YY1, Img)
    ObjMatlab.Execute ("yd=wden(ny,'sqtwolog','s','mln',4,'db5');")
    ReDim Preserve YY2(1 To Points_Num)
    Call ObjMatlab.GetFullMatrix("yd", "base", YY2, Img)
    
    Call ObjMatlab.PutFullMatrix("nz", "base", ZZ1, Img)
    ObjMatlab.Execute ("zd=wden(nz,'sqtwolog','s','mln',4,'db5');")
    ReDim Preserve ZZ2(1 To Points_Num)
    Call ObjMatlab.GetFullMatrix("zd", "base", ZZ2, Img)
    
    StatusBar1.Panels(1).Text = "去噪已完成"
    
    
End Sub

Private Sub TxtSam_Change()
    If TxtSam.Text <> "" Then
        If CInt(TxtSam.Text) > 0 Then
            Sample_HZ = CInt(TxtSam.Text)
            Command1.Enabled = True
            Command2.Enabled = True
        End If
    End If
    MCOU_HZ.Enabled = True
     
End Sub


Private Sub XDnoiseview_Click()
    Dim Img() As Double
    Call ObjMatlab.PutFullMatrix("b", "base", XX2, Img)
    ObjMatlab.Execute ("plot(b);grid on")
    
End Sub

Private Sub YDnoiseview_Click()
    Dim Img() As Double
    Call ObjMatlab.PutFullMatrix("b", "base", YY2, Img)
    ObjMatlab.Execute ("plot(b);grid on")
End Sub

Private Sub ZDnoiseview_Click()
    Dim Img() As Double
    Call ObjMatlab.PutFullMatrix("b", "base", ZZ2, Img)
    ObjMatlab.Execute ("plot(b);grid on")
End Sub