Click here to Skip to main content
Click here to Skip to main content
Articles » Languages » VB.NET » Hardware » Downloads
 
Add your own
alternative version

Sound Scanner and FFT Analyzer

, 16 Feb 2010 CDDL
Scanning analog input, and FFT convertion and analyzing.
SoundScan.zip
SoundScan
bin
Debug
ICO_FKR.ico
SoundAnalysis.dll
ICO_FKR.ico
My Project
Application.myapp
Settings.settings
PORT.DLL
SoundAnalysis.dll
SoundScan_Feb112010.zip
SoundScan
bin
Debug
ICO_FKR.ico
SoundAnalysis.dll
SoundScan.exe
SoundScan.pdb
SoundScan.vshost.exe
ICO_FKR.ico
My Project
Application.myapp
Settings.settings
obj
Debug
ResolveAssemblyReference.cache
SoundScan.exe
SoundScan.Frm_Detailed.resources
SoundScan.Frm_SoundScan.resources
SoundScan.pdb
SoundScan.Resources.resources
SoundScan.vbproj.GenerateResource.Cache
TempPE
PORT.DLL
SoundAnalysis.dll
SoundScan_Feb132010.zip
ICO_FKR.ico
SoundAnalysis.dll
SoundScan.exe
SoundScan.pdb
SoundScan.vshost.exe
ICO_FKR.ico
Application.myapp
Settings.settings
ResolveAssemblyReference.cache
SoundScan.exe
SoundScan.Frm_Detailed.resources
SoundScan.Frm_SoundScan.resources
SoundScan.pdb
SoundScan.Resources.resources
SoundScan.vbproj.GenerateResource.Cache
PORT.DLL
SoundAnalysis.dll
SoundScan.suo
#Region "References"

Option Compare Text
Option Strict Off
Option Explicit On
Imports VB = Microsoft.VisualBasic
Imports Microsoft.VisualBasic.DateAndTime
Imports Microsoft.VisualBasic.FileIO
Imports System
Imports System.Drawing
Imports System.Drawing.Design
Imports System.Drawing.Drawing2D
Imports System.Drawing.Imaging
Imports System.Drawing.Printing
Imports System.Drawing.Text
Imports System.Security.Permissions
Imports System.Threading
Imports SoundAnalysis

#End Region

Public Class Frm_SoundScan

#Region "API Definition"

    Private Declare Auto Function BitBlt Lib "gdi32.dll" (ByVal hdcDest As IntPtr, ByVal nXDest As Integer, ByVal nYDest As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hdcSrc As IntPtr, ByVal nXSrc As Integer, ByVal nYSrc As Integer, ByVal dwRop As System.Int32) As Boolean
    Private Declare Function SOUNDIS Lib "Port.Dll" () As Integer
    Private Declare Sub SOUNDCAPIN Lib "Port.Dll" ()
    Private Declare Sub SOUNDCAPOUT Lib "Port.Dll" ()
    Private Declare Sub SOUNDIN Lib "Port.Dll" (ByVal A() As Byte, ByVal Gr As Long)
    Private Declare Sub SOUNDOUT Lib "Port.Dll" (ByVal A() As Char, ByVal Gr As Long)
    Private Declare Function SOUNDGETRATE Lib "Port.Dll" () As Integer
    Private Declare Function SOUNDSETRATE Lib "Port.Dll" (ByVal Rate As Long) As Long
    Private Declare Function SOUNDGETBYTES Lib "Port.Dll" () As Integer
    Private Declare Function SOUNDSETBYTES Lib "Port.Dll" (ByVal Rate As Long) As Long

#End Region

#Region "Variables"

    Private WithEvents m_PrintDocument As PrintDocument
    Private Bt_mn As Bitmap
    Private m_PrintBitmap As Bitmap
    Private GRFX As Graphics
    Private Const SRCCOPY As Integer = &HCC0020
    Private _Height As Single = 1
    Private _Width As Single = 1
    Private X_0 As Single = 0
    Private X_1 As Single = 1
    Private X_Unit As Single = 1
    Private Y_0 As Single = 0
    Private Y_1 As Single = 1
    Private Y_Unit As Single = 1
    Private _Heigth_Fourier As Double = 1
    Private _Width_Fourier As Double = 1
    Public _Time_Interval As Single = 100
    Private _Removed_Freq As Double = -1
    Private _Freq_01 As Double = 1
    Private _Freq_02 As Double = 1
    Private _U_B As Decimal = 1
    Private _L_B As Decimal = 0

    Private _Arr_Refined() As PointF
    Private _Rate As Integer = 11025
    Private _Samples() As Byte
    Public _Size As Decimal = 0
    Public _Bits As _Sample_Bit = _Sample_Bit.Mono
    Private _Samples_Refined() As Double
    Public _Arr_Spec() As Double
    Private _Arr_Samples As ArrayList = New ArrayList
    Private _Gain As Single = 1
    Private _Window_Size As Integer
    Private _WindowFilter() As Double
    Private Working As Boolean = False

#End Region

#Region "Enums"

    Public Enum _Sample_Rate
        _11KHz = 11025
        _22KHz = 22050
        _44KHz = 44100
    End Enum

    Public Enum _Sample_Bit
        Mono = 8
        Stereo = 16
    End Enum

#End Region

#Region "Component Events"

    Private Sub Frm_SoundScan_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Try
            Cmb_Samples.SelectedIndex = 0
            _Height = PicBox_Signal.Height
            _Width = PicBox_Signal.Width
            X_0 = _Width * 0.1
            X_1 = _Width * 0.9
            Y_0 = _Height * 0.1
            Y_1 = _Height * 0.9
            _Heigth_Fourier = PicBox_Fourier.Height
            _Width_Fourier = PicBox_Fourier.Width

            If _Bits = _Sample_Bit.Mono Then
                Y_Unit = 0.8 * _Height / 256
            Else
                Y_Unit = 0.8 * _Height / 65536
            End If
            TextBox_Filling()
        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.Critical, "FKR_Sound Scan")
        End Try
    End Sub

    Private Sub Cmd_Detailed_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Cmd_Detailed.Click
        Dim NewF As Frm_Detailed = New Frm_Detailed
        NewF.ShowDialog(Me)
    End Sub

    Private Sub Cmd_Start_Stop_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Cmd_Start_Stop.Click
        Try
            Working = Not Working
            If Working Then
                Call Start()
            Else
                Call _Stop()
            End If
        Catch ex As Exception
            Call _Stop()
            MsgBox(ex.Message, MsgBoxStyle.Critical, "FKR_Sound Scan")
        End Try
    End Sub

    Private Sub Cmb_Samples_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Cmb_Samples.SelectedIndexChanged
        Try
            Select Case Cmb_Samples.SelectedIndex
                Case 0
                    _Rate = _Sample_Rate._11KHz
                Case 1
                    _Rate = _Sample_Rate._22KHz
                Case 2
                    _Rate = _Sample_Rate._44KHz
            End Select
            SOUNDSETRATE(CLng(_Rate))
            Call TextBox_Filling()
        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.Critical, "FKR_Sound Scan")
        End Try
    End Sub

    Private Sub NumUpDown_Freq_01_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NumUpDown_Freq_01.ValueChanged
        _Freq_01 = NumUpDown_Freq_01.Value
    End Sub

    Private Sub NumUpDown_Freq_02_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NumUpDown_Freq_02.ValueChanged
        _Freq_02 = NumUpDown_Freq_02.Value
    End Sub

    Private Sub NumUpDown_Gain_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NumUpDown_Gain.ValueChanged
        _Gain = NumUpDown_Gain.Value
        If _Bits = _Sample_Bit.Mono Then
            Y_Unit = 0.8 * _Height / 256
        Else
            Y_Unit = 0.8 * _Height / 65536
        End If
    End Sub

    Private Sub NumUpDown_Resolution_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NumUpDown_Resolution.ValueChanged
        Try
            SOUNDSETBYTES(CLng(NumUpDown_Resolution.Value / 8))
            _Bits = NumUpDown_Resolution.Value
            If _Bits = _Sample_Bit.Mono Then
                Y_Unit = 0.8 * PicBox_Signal.Height / 256
            Else
                Y_Unit = 0.8 * PicBox_Signal.Height / 65536
            End If
            Call TextBox_Filling()
        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.Critical, "FKR_Sound Scan")
        End Try
    End Sub

    Private Sub NumUpDown_Removed_Frequency_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NumUpDown_Removed_Frequency.ValueChanged
        _Removed_Freq = NumUpDown_Removed_Frequency.Value * _Time_Interval / 1000
        Return
    End Sub

    Private Sub NumUpDown_Timing_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NumUpDown_Timing.ValueChanged
        Try
            Tmr_Runner.Interval = CInt(NumUpDown_Timing.Value)
            _Time_Interval = CInt(NumUpDown_Timing.Value)
            Call TextBox_Filling()
        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.Critical, "FKR_Sound Scan")
        End Try
    End Sub

    Private Sub NumUpDown_WindowFilter_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NumUpDown_WindowFilter.ValueChanged
        ReDim _WindowFilter(NumUpDown_WindowFilter.Value - 1)
        _Window_Size = NumUpDown_WindowFilter.Value
    End Sub

    Private Sub NumUpDown_Lower_Bound_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NumUpDown_Lower_Bound.ValueChanged
        _L_B = NumUpDown_Lower_Bound.Value
        If _L_B > _U_B Then
            _L_B = _U_B
        End If
    End Sub

    Private Sub NumUpDown_Upper_Bound_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NumUpDown_Upper_Bound.ValueChanged
        _U_B = NumUpDown_Upper_Bound.Value
        If _U_B < _L_B Then _U_B = _L_B
    End Sub

#End Region

#Region "Printing"

    Private Function GetFormImage() As Bitmap
        Dim me_gr As Graphics = Me.CreateGraphics
        Dim bm As New Bitmap(Me.ClientSize.Width, Me.ClientSize.Height, me_gr)
        Dim bm_gr As Graphics = me_gr.FromImage(bm)
        Dim bm_hdc As IntPtr = bm_gr.GetHdc
        me_gr.RotateTransform(180)
        Dim me_hdc As IntPtr = me_gr.GetHdc
        BitBlt(bm_hdc, 0, 0, Me.ClientSize.Width, Me.ClientSize.Height, me_hdc, 0, 0, SRCCOPY)
        me_gr.ReleaseHdc(me_hdc)
        bm_gr.ReleaseHdc(bm_hdc)

        Return bm
    End Function

    Private Sub m_PrintDocument_PrintPage(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles m_PrintDocument.PrintPage
        Try
            Dim X As Integer, Y As Integer
            Dim Bt_mn As Bitmap = New Bitmap(400, 35)
            Dim GRFX As Graphics = Graphics.FromImage(Bt_mn)
            'Dim ICO As Icon = New Icon(CurDir() & "\" & "FKR.ICO")
            'GRFX.DrawString("Farzankar Ind Co.FKR-LKS_P_V20" & vbNewLine & "Leakage Test Machine", New Font("Tahoma", 10), Brushes.DarkGoldenrod, New PointF(1, 1))
            'Bt_mn.RotateFlip(RotateFlipType.Rotate90FlipNone)

            m_PrintBitmap.RotateFlip(RotateFlipType.Rotate90FlipNone)
            e.PageSettings.Landscape = True
            X = e.MarginBounds.X + (e.MarginBounds.Width - m_PrintBitmap.Width) \ 2
            Y = e.MarginBounds.Y + (e.MarginBounds.Height - m_PrintBitmap.Height) \ 2
            e.Graphics.DrawImageUnscaled(m_PrintBitmap, X, Y)

            e.HasMorePages = False
        Catch ex As Exception
            MsgBox(ex.Message & vbNewLine & "Error Occurred during printing process." & vbNewLine & "Please check your printing settig or the network connection", MsgBoxStyle.Critical)
        End Try
    End Sub

#End Region

#Region "Timer"

    Private Sub Tmr_Runner_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Tmr_Runner.Tick
        Try
            If Not Working Then
                Call _Stop()
                Exit Try
            End If
            Call _Data_Capturing()
            Call _Fourier_Transformation()
            Call Picture_Redrawing_Wave(_Samples_Refined)
            Call Draw_Fourier(_Arr_Spec, _Width_Fourier, _Heigth_Fourier / 2)
        Catch ex As Exception
            Call _Stop()
            MsgBox(ex.ToString, MsgBoxStyle.Critical, "FKR_Sound Scan")
        End Try
    End Sub

#End Region

#Region "User Defiend Functions and Subs"

    Private Sub Start()
        Try
            Working = True
            Cmd_Start_Stop.Text = "Stop"
            Cmb_Samples.Enabled = False
            NumUpDown_Resolution.Enabled = False
            NumUpDown_Timing.Enabled = False
            NumUpDown_WindowFilter.Enabled = False
            Cmd_Detailed.Enabled = False
            Call TextBox_Filling()
            Tmr_Runner.Enabled = Working
        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.Critical, "FKR_Sound Scan")
        End Try
    End Sub

    Private Sub _Stop()
        Try
            Working = False
            Cmd_Start_Stop.Text = "Start"
            Cmb_Samples.Enabled = True
            NumUpDown_Resolution.Enabled = True
            NumUpDown_Timing.Enabled = True
            NumUpDown_WindowFilter.Enabled = True
            Cmd_Detailed.Enabled = True
            Call TextBox_Filling()
            Tmr_Runner.Enabled = Working
        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.Critical, "FKR_Sound Scan")
        End Try
    End Sub

    Private Function _Data_Capturing() As Boolean
        Try
            Dim I As Integer, J As Integer
            Dim Str_Out As String = ""
            Dim _Sum As Double = 0
            Dim _X_Unit_01 As Single = _Width / _Freq_01
            Dim _X_Unit_02 As Single = _Width / _Freq_02
            Dim _Step_01 As Single = _Width / _Size
            Dim _Temp_01 As Single = 0
            Dim _Temp_02 As Single = 0
            If _Bits = _Sample_Bit.Mono Then
                ReDim _Samples(_Size - 1)
            Else
                ReDim _Samples((_Size * 2) - 1)
            End If
            SOUNDIN(_Samples, CLng(_Size))
            If _Bits = _Sample_Bit.Mono Then
                Str_Out = ""
                ReDim _Samples_Refined(_Size - 2)
                For I = 0 To (UBound(_Samples) - 1)
                    'The Range is amoung 0 to 255
                    _Temp_01 = (I * _Step_01 * 100) Mod (_X_Unit_01 * 100)
                    _Temp_01 = _Temp_01 / (100 * _X_Unit_01)
                    _Temp_02 = (I * _Step_01 * 100) Mod (_X_Unit_02 * 100)
                    _Temp_02 = _Temp_02 / (100 * _X_Unit_02)
                    _Samples_Refined(I) = CDbl(CInt(_Samples(I)) - 128) + (Math.Sin(2 * Math.PI * _Temp_01) * 32) + (Math.Sin(2 * Math.PI * _Temp_02) * 32)
                    _Samples_Refined(I) = ((_Samples_Refined(I) / 128) * _Gain) * 128
                Next
            Else
                ReDim _Samples_Refined(_Size - 1)
                Dim _Byte_arr(1) As Byte
                For I = 0 To UBound(_Samples) - 1 Step 2
                    _Byte_arr(0) = _Samples(I)
                    _Byte_arr(1) = _Samples(I + 1)
                    'The Range changed to 0 to 65535
                    _Temp_01 = (I * _Step_01 * 50) Mod (_X_Unit_01 * 100)
                    _Temp_01 = _Temp_01 / (100 * _X_Unit_01)
                    _Temp_02 = (I * _Step_01 * 50) Mod (_X_Unit_02 * 100)
                    _Temp_02 = _Temp_02 / (100 * _X_Unit_02)
                    _Samples_Refined(I / 2) = CDbl(CInt(BitConverter.ToInt16(_Byte_arr, 0))) + (Math.Sin(2 * Math.PI * _Temp_01) * 1024) + (Math.Sin(2 * Math.PI * _Temp_02) * 1024)
                    _Samples_Refined(I / 2) = ((_Samples_Refined(I / 2) / 32768) * _Gain) * 32768
                Next
            End If
            'Window Filter Implementing
            ReDim _WindowFilter(_Window_Size - 1)
            For I = 0 To UBound(_Samples_Refined)
                _WindowFilter(I Mod _Window_Size) = _Samples_Refined(I)
                _Sum = 0
                For J = 0 To UBound(_WindowFilter)
                    _Sum += _WindowFilter(J)
                Next
                _Samples_Refined(I) = (_Sum / _Window_Size)
            Next
        Catch ex As Exception
            Call _Stop()
            MsgBox(ex.ToString, MsgBoxStyle.Critical, "FKR_Sound Scan")
        End Try
    End Function

    Private Function _Fourier_Transformation() As Boolean
        Try
            'Window Filtering
            Dim _I As Integer = 0
            Dim _J As Integer = 0
            Dim _Max As Double = -100
            Dim _Index As Integer = -1
            Dim _Freq_Out As Double = -1
            Dim _PointF As PointF = New PointF(-1, -1)
            Dim _Flag As Boolean = False
            'Fourier Transforming
            _Arr_Spec = SoundAnalysis.FftAlgorithm.Calculate(_Samples_Refined)
            Dim _Arr_Length As Integer = _Arr_Spec.Length
            For _I = 0 To CInt(UBound(_Arr_Spec) * 0.95)
                If (_Size * _I / _Arr_Length >= 0) And (_Size * _I / _Arr_Length < 1) Then
                    _Arr_Spec(_I) = 0
                End If
                If (_Size * _I / _Arr_Length > (_Removed_Freq - 1)) And (_Size * _I / _Arr_Length < (_Removed_Freq + 1)) Then
                    _Arr_Spec(_I) = 0
                End If
                If _Max < _Arr_Spec(_I) Then
                    _Max = _Arr_Spec(_I)
                    _Index = _I
                End If
            Next
            'Lbl_Freq.Text = "M.E. Freq : " & CDbl((_Size * _Index / _Arr_Length) * (1000 / _Time_Interval)).ToString("0.0") & " Hz"
            Return True
        Catch ex As Exception
            Call _Stop()
            MsgBox(ex.ToString, MsgBoxStyle.Critical, "FKR_Sound Scan")
            Return False
        End Try
    End Function

    Private Sub TextBox_Filling()
        Dim Str_Out As String = ""
        If SOUNDIS <> 0 Then
            _Size = (Tmr_Runner.Interval / 1000) * _Rate
            Dim _Arr_Spec_Length As Decimal = Math.Pow(2, Math.Floor(Math.Log(_Size) / Math.Log(2)) + 1)
            Dim _Sample As Decimal = (_Arr_Spec_Length / 2) + 1
            Dim _X_Max As Decimal = CInt(_Size * CSng(_Sample) / CSng(_Arr_Spec_Length))
            _X_Max *= 1000 / _Time_Interval
            Lbl_Frreq1.Text = "x " & CDbl(1000 / _Time_Interval).ToString("0") & " Hz"
            Lbl_Frreq2.Text = "x " & CDbl(1000 / _Time_Interval).ToString("0") & " Hz"
            X_Unit = 0.8 * _Width / _Size
            NumUpDown_Upper_Bound.Maximum = _X_Max
            NumUpDown_Lower_Bound.Maximum = _X_Max * 0.8
            NumUpDown_Upper_Bound.Value = _X_Max
            Str_Out = "Sound Card is Available!" & vbNewLine
            Str_Out &= "Set Recording Rate: " & (SOUNDGETRATE / 1000).ToString("0.000") & "KHz" & vbNewLine
            Str_Out &= "Set Recording Resolution: " & SOUNDGETBYTES * 8 & " Bit" & vbNewLine
            Str_Out &= "Timing Interval : " & Tmr_Runner.Interval & " mSec" & vbNewLine
            Str_Out &= "Sampling process : " & Microsoft.VisualBasic.IIf(Working, "Running", "Stopped") & vbNewLine
            Str_Out &= "Sample No. : " & _Size & vbNewLine
            Str_Out &= "Buffer Size: " & _Size * SOUNDGETBYTES & " Bytes"
        Else
            Str_Out = "No Sound Card found!"
            MsgBox(Str_Out, MsgBoxStyle.Critical)
            End
        End If
        Txt_Info.Text = Str_Out

    End Sub

    Private Function Drawing_Initialize(ByRef GRFX As Graphics) As Boolean
        Try
            GRFX.Clear(Color.WhiteSmoke)
        Catch ex As Exception
        End Try
    End Function

    Private Function Picture_Redrawing_Wave(ByVal _Arr_In() As Double) As Boolean
        Try
            Dim _Draw_Pen As Pen = New Pen(Color.LightGreen, 1)
            Dim X_Slot As Single = 0.8 * PicBox_Signal.Width / 10
            Dim Y_Slot As Single = 0.8 * PicBox_Signal.Height / 10
            Dim I As Integer = 0
            Dim J As Integer = 0
            Dim Sum As Single = 0
            Dim _Arr_PointF() As PointF
            Dim X As Single = 0
            Dim Y As Single = 0
            If _Bits = _Sample_Bit.Mono Then
                For I = 0 To UBound(_Arr_In)
                    _Arr_In(I) = _Arr_In(I) + 128
                Next
            Else
                For I = 0 To UBound(_Arr_In)
                    _Arr_In(I) = _Arr_In(I) + 32768
                Next
            End If

            Bt_mn = New Bitmap(CInt(_Width), CInt(_Height))
            GRFX = Graphics.FromImage(Bt_mn)
            GRFX.Clear(Color.DarkGreen)
            GRFX.DrawLine(Pens.Black, X_0, Y_0, X_0, Y_1)
            GRFX.DrawLine(Pens.Black, X_0, Y_1, X_1, Y_1)
            For I = 1 To 9
                GRFX.DrawLine(_Draw_Pen, X_0, Y_0 + (I * Y_Slot), X_1, Y_0 + (I * Y_Slot))
                GRFX.DrawLine(_Draw_Pen, X_0 + (I * X_Slot), Y_0, X_0 + (I * X_Slot), Y_1)
            Next
            _Draw_Pen.Width = 2.0F
            GRFX.DrawLine(_Draw_Pen, X_0, Y_0 + (5 * Y_Slot), X_1, Y_0 + (5 * Y_Slot))
            GRFX.DrawLine(_Draw_Pen, X_0 + (5 * X_Slot), Y_0, X_0 + (5 * X_Slot), Y_1)
            X_Unit = 0.8 * PicBox_Signal.Width / UBound(_Samples_Refined)

            'Drawing Preparation
            ReDim _Arr_PointF(UBound(_Arr_In))
            For I = 0 To UBound(_Arr_In)
                X = X_0 + (I * X_Unit)
                Y = Y_1 - (_Arr_In(I) * Y_Unit)
                _Arr_PointF(I) = New PointF(X, Y)
            Next
            GRFX.DrawLines(Pens.AntiqueWhite, _Arr_PointF)
            GRFX.Flush()
            PicBox_Signal.Image = Bt_mn
        Catch ex As Exception
            Call _Stop()
            MsgBox(ex.ToString, MsgBoxStyle.Critical, "FKR_Sound Scan")
        End Try
    End Function

    Private Function Draw_Fourier(ByVal _Arr_In() As Double, ByVal _Base_Distance As Single, ByVal _Heigth_Distance As Single) As Boolean
        Try
            Dim _Sample As Decimal = CInt((UBound(_Arr_In) / 2) + 1)
            Dim _Sample_Start As Decimal = _L_B * _Arr_In.Length * _Time_Interval / (_Size * 1000)
            Dim _Sample_End As Decimal = _U_B * _Arr_In.Length * _Time_Interval / (_Size * 1000)
            If _Sample_End > _Sample Then _Sample_End = _Sample
            Dim _Sample_In_Use As Decimal = _Sample_End - _Sample_Start + 1
            If _Sample_In_Use > _Sample Then _Sample_In_Use = _Sample
            Dim _X_Max As Single = _Size * CSng(_Sample) / _Arr_In.Length
            Dim _X_Max_In_Use As Decimal = _Size * CSng(_Sample_In_Use) / _Arr_In.Length
            Dim _X_Step As Double = _Base_Distance * 0.8 / _X_Max
            Dim _X_Step_In_Use As Decimal = _Base_Distance * 0.8 / _X_Max_In_Use
            Dim _Arr_PointF() As PointF
            Dim _Arr_Refined() As PointF
            Dim _Flag As Boolean = False
            Dim _I As Decimal = 0
            Dim _X As Single = 0
            Dim _X_0 As Single = 0.1 * _Base_Distance
            Dim _Y As Single = 0
            Dim _Y_1 As Single = 2 * _Heigth_Distance
            Dim _Y_Unit As Single = 0.9 * _Heigth_Distance
            Dim _Drawing_Pen As Pen = New Pen(Color.Black, 1.8F)
            Dim _Max As Double = -1
            Dim _Index As Integer = -1
            ReDim _Arr_PointF(_Sample_In_Use)
            ReDim _Arr_Refined(_Sample)
            For _I = _Sample_Start To _Sample_End
                If _Max < _Arr_In(_I) Then _Max = _Arr_In(_I)
            Next
            For _I = 0 To UBound(_Arr_Refined)
                _Arr_Refined(_I) = New PointF(CSng(_Size * (_I - _Sample_Start) / _Arr_In.Length), CSng(_Arr_In(_I) / _Max))
            Next
            Bt_mn = New Bitmap(CInt(_Base_Distance), CInt(_Y_1))
            GRFX = Graphics.FromImage(Bt_mn)
            GRFX.DrawLine(_Drawing_Pen, 0, _Heigth_Distance, _Base_Distance, _Heigth_Distance)
            GRFX.DrawLine(_Drawing_Pen, CSng(_Base_Distance * 0.1), 0, CSng(_Base_Distance * 0.1), _Y_1)
            For _I = _Sample_Start To CDbl(_Sample_Start + (_Sample_In_Use * 0.9)) Step CDbl(_Sample_In_Use / 10)
                GRFX.DrawString(((_Size * CSng(_I) / _Arr_In.Length) * 1000 / _Time_Interval).ToString("0") & " Hz", New Font("Arial", 8, FontStyle.Regular), Brushes.AntiqueWhite, CSng(((0.8 * _Base_Distance * (_I - _Sample_Start) / _Sample_In_Use) + 0.1 * _Base_Distance) - 10), CSng(_Y_1 / 2))
            Next
            GRFX.DrawString((_Sample_End * _Size * 1000 / (_Time_Interval * _Arr_In.Length)).ToString("0") & " Hz", New Font("Arial", 8, FontStyle.Regular), Brushes.AntiqueWhite, CSng(0.9 * _Base_Distance - 10), CSng(_Y_1 / 2))
            For _I = Math.Floor(_Sample_Start) To Math.Ceiling(_Sample_End)
                _X = (_Arr_Refined(_I).X * _X_Step_In_Use) + _X_0
                _Y = (_Arr_Refined(_I).Y * _Y_Unit) + _Heigth_Distance
                _Y = _Y_1 - _Y
                _Arr_PointF(_I - _Sample_Start) = New PointF(_X, _Y)
            Next
            If _Arr_PointF(UBound(_Arr_PointF)).X = 0 Then
                _Arr_PointF(UBound(_Arr_PointF)) = _Arr_PointF(UBound(_Arr_PointF) - 1)
            End If
            GRFX.DrawLines(Pens.AntiqueWhite, _Arr_PointF)
            GRFX.Flush()
            PicBox_Fourier.Image = Bt_mn
        Catch ex As Exception
            Call _Stop()
            MsgBox(ex.Message, MsgBoxStyle.Critical, "FKR_Fast Fourier Transition Tester")
            Return False
        End Try
    End Function

#End Region

End Class

By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.

If a file you wish to view isn't highlighted, and is a text file (not binary), please let us know and we'll add colourisation support for it.

License

This article, along with any associated source code and files, is licensed under The Common Development and Distribution License (CDDL)

Share

About the Author

Mahdi Mansouri
Engineer
Malaysia Malaysia
PhD Candidate in Biomedical Eng., Control
M.Eng Electronics, Control
B.Eng Computer, Hardware
That's all ;D !

| Advertise | Privacy | Mobile
Web02 | 2.8.141022.2 | Last Updated 16 Feb 2010
Article Copyright 2010 by Mahdi Mansouri
Everything else Copyright © CodeProject, 1999-2014
Terms of Service
Layout: fixed | fluid