Imports Microsoft.Win32.SafeHandles

Public Class Form1    

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim file As String = ""
        Dim dlg As New OpenFileDialog
        dlg.Title = "select wav file to play"
        dlg.InitialDirectory = "c:\windows\media"
        If dlg.ShowDialog = DialogResult.OK Then
            file = dlg.FileName
        End If
        loadplay(file)
    End Sub
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Dim File As String = ""
        Dim dlg As New FolderBrowserDialog
        dlg.SelectedPath = "c:\windows\media"
        dlg.Description = "browse for folder to store recorded audio"
        If dlg.ShowDialog = DialogResult.OK Then
            File = dlg.SelectedPath
        End If
        record(file)
    End Sub
    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        stopplay()
    End Sub

    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
        Dim File As String = ""
        Dim dlg As New FolderBrowserDialog
        dlg.SelectedPath = "c:\windows\media"
        dlg.Description = "browse for folder to store recorded audio"
        If dlg.ShowDialog = DialogResult.OK Then
            File = dlg.SelectedPath
        End If
        construct(File)
    End Sub
    Private Sub TrackBar1_MouseCaptureChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TrackBar1.MouseCaptureChanged
        frequency = TrackBar1.Value * 0.267 + 0.078
        Label1.Text = (340 * TrackBar1.Value + 100) & "  Hz"
    End Sub

    Private Sub CheckBox1_CheckStateChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles CheckBox1.CheckStateChanged
        display = CheckBox1.CheckState
    End Sub
End Class
Public Class Form2
    Dim dsize As Integer = 1000
    Dim nx As Integer = 1
    Dim start As Integer = 0
    Private Sub display()
        Dim g As Graphics = CreateGraphics()
        g.DrawLine(Pens.Black, 10, 35, 10, 290)
        g.DrawLine(Pens.Black, 10, 162, 1010, 162)
        Dim nfont As New System.Drawing.Font("arial", 16, FontStyle.Regular)
        g.DrawString("255", nfont, Brushes.Black, 10, 15)
        g.DrawString("000", nfont, Brushes.Black, 10, 290)
        g.DrawString(start, nfont, Brushes.Cyan, 10, 162)
        g.DrawString(start + dsize, nfont, Brushes.Cyan, 950, 162)
        For i = start To start + dsize - 2
            g.DrawLine(Pens.Cyan, 10 + nx * (i - start), 35 + data(56 + i), 11 + nx * (i - start), 35 + data(57 + i))
        Next
        g.Dispose()
    End Sub
    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        display()
        Timer1.Enabled = False
    End Sub
    Private Sub TrackBar2_MouseCaptureChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TrackBar2.MouseCaptureChanged
        nx = 1 + Math.Floor(TrackBar2.Value / 25)
        dsize = Math.Floor(1000 / nx)
        start = Math.Floor(TrackBar1.Value / 100 * (data.Length - 56)) - dsize
        If start <= 0 Then start = 0
        Invalidate()
        Timer1.Enabled = True
    End Sub
    Private Sub TrackBar1_MouseCaptureChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TrackBar1.MouseCaptureChanged
        nx = 1 + Math.Floor(TrackBar2.Value / 25)
        dsize = Math.Floor(1000 / nx)
        start = Math.Floor(TrackBar1.Value / 100 * (data.Length - 56)) - dsize
        If start <= 0 Then start = 0
        Invalidate()
        Timer1.Enabled = True
    End Sub    
    Private Sub Form2_ClientSizeChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.ClientSizeChanged
        Timer1.Enabled = True
    End Sub
End Class
Imports Microsoft.DirectX
Imports Microsoft.DirectX.DirectSound
Imports Microsoft.DirectX.DirectSound.Buffer
Imports System.Threading
Module Module1
    Public appdevice As Device  'default audio device "0"
    Public recdevice As Capture  'again default device
    Public sbuff As SecondaryBuffer  'playback audio buffer
    Public cbuff As CaptureBuffer  'record audio buffer
    Public rbuffd As CaptureBufferDescription 'record buffer description
    Public inputformat As WaveFormat 'format of input wave
    Public capdevguid As Guid = Guid.Empty 'use system guid for default capture
    Public fs As System.IO.FileStream  'read audio file
    Public rs As New System.IO.MemoryStream(80000) 'memory store
    Public data As Byte() 'data access to pcm
    Public frequency As Double = 1 'about 1000 hz to start
    Public display As Boolean = False
    Public Sub loadplay(ByVal file As String)
        Try
            fs = New System.IO.FileStream(file, IO.FileMode.Open)
        Catch err As Exception
            MsgBox("could not load file")
        End Try
        play(fs)
    End Sub
    Private Sub play(ByVal rs As System.IO.Stream)
        Try
            appdevice = New Device()
            appdevice.SetCooperativeLevel(Form1, CooperativeLevel.Priority)
            rs.Seek(0, IO.SeekOrigin.Begin)
            sbuff = New SecondaryBuffer(rs, appdevice)
            Dim flags = BufferPlayFlags.Looping
            sbuff.SetCurrentPosition(0) 'start at begining
            sbuff.Play(0, flags) 'can now play
        Catch err As Exception
            MsgBox("could not play this file")
        End Try
    End Sub
    Public Sub stopplay()
        Try
            sbuff.Stop()
            sbuff.Dispose()
            appdevice.Dispose()
            fs.Close()
        Catch err As Exception
            MsgBox("could not stop")
        End Try
    End Sub
    Public Sub record(ByVal file As String)
        Try
            recdevice = New Capture(capdevguid)
            rbuffd = New CaptureBufferDescription  'record buffer description
            rbuffd.BufferBytes = 80000  'size of buffer
            inputformat.FormatTag = WaveFormatTag.Pcm 'must be pcm
            inputformat.SamplesPerSecond = 8000 'for voice only
            inputformat.BitsPerSample = 8 'only for voice
            inputformat.Channels = 1 'mono only
            inputformat.BlockAlign = 1
            inputformat.AverageBytesPerSecond = 8000 'must specify all
            rbuffd.Format = inputformat  'set buffer description
            cbuff = New CaptureBuffer(rbuffd, recdevice) 'we now have device and buffer
            cbuff.Start(True)
            System.Threading.Thread.Sleep(8000)
            cbuff.Stop()
            Dim readpos As Integer
            Dim capturepos As Integer
            cbuff.GetCurrentPosition(capturepos, readpos)
            rs.Seek(56, IO.SeekOrigin.Begin) 'leave 56 bytes for header
            cbuff.Read(0, rs, readpos, LockFlag.None)
            rs.Seek(0, IO.SeekOrigin.Begin)
            header(rs) 'need header
            data = New [Byte](rs.Length - 1) {}
            Dim br As New System.IO.BinaryReader(rs)
            rs.Seek(0, IO.SeekOrigin.Begin)
            br.Read(data, 0, rs.Length)
            My.Computer.FileSystem.WriteAllBytes(file & "\voice.wav", data, False)
            recdevice.Dispose()
            cbuff.Dispose()
        Catch err As Exception
            MsgBox("could not record audio")
        End Try
        If display Then
            Dim frm As New Form2
            frm.Show()
        End If
    End Sub
    Private Sub header(ByVal rs As System.IO.Stream)
        Try
            rs.Seek(0, IO.SeekOrigin.Begin)
            Dim bw As New System.IO.BinaryWriter(rs)
            Dim head As Byte() = My.Resources.waveheader
            Try                  'has format for pcm as wav description
                Dim wavelength As Integer = rs.Length - 8
                head(5) = Math.Floor(wavelength / 256) 'MSB
                head(4) = wavelength - (head(5) * 256) 'LSB
                Dim wavechunk As Integer = wavelength - 48   'chunk length
                head(53) = Math.Floor(wavechunk / 256) 'MSB
                head(52) = wavechunk - head(53) * 256  'LSB
            Catch err As Exception
            End Try ' only for 65536 bytes about 8 seconds
            For i = 0 To 55
                bw.Write(head(i))
            Next
        Catch err As Exception
            MsgBox("could not insert header")
        End Try
    End Sub
    Private Sub cro(ByVal rs As System.IO.FileStream)
        Data = New [Byte](80000) {}
        Dim br As New System.IO.BinaryReader(rs)
        br.Read(data, 56, rs.Length)
        br.Close()
    End Sub
    Public Sub construct(ByVal file As String)
        data = New [Byte](64151) {}
        rs.SetLength(64152)
        header(rs) 'put header in memorystream
        Dim angle As Double = 0
        For i = 56 To 64151  'first 56 bytes for header
            data(i) = 127 + 127 * Math.Sin((angle + (i - 56)) * frequency)
        Next
        Dim br As New System.IO.BinaryReader(rs)
        rs.Seek(0, IO.SeekOrigin.Begin)
        br.Read(data, 0, 55) 'get header into byte array
        My.Computer.FileSystem.WriteAllBytes(file & "\construct.wav", data, False)
        If display Then
            Dim frm As New Form2
            frm.Show()
        End If
    End Sub
End Module