Keskustelu: Koodit: VB.NET: Äänikortilta näytteen luku

Module modWave
    Public wFormat As WAVEFORMAT
    Public wHdr As WAVEHDR

    Public Const WAVE_FORMAT_PCM = &H1
    Public Const WAVE_FORMAT_EXTENSIBLE = &HFFFE
    Public Const WAVE_FORMAT_QUERY = &H1
    Public Const WAVE_ALLOWSYNC = &H2
    Public Const WAVERR_BASE = 32
    Public Const WAVERR_STILLPLAYING = (WAVERR_BASE + 1)
    Public Const WAVE_MAPPER As System.Int32 = -1

    '****** API
    Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Integer, ByVal dwBytes As Integer) As IntPtr
    Public Declare Function GlobalLock Lib "kernel32" (ByVal hmem As IntPtr) As IntPtr
    Public Declare Function GlobalFree Lib "kernel32" (ByVal hmem As IntPtr) As Integer
    Declare Function waveInGetNumDevs Lib "winmm.dll" () As System.Int16
    Declare Function waveInAddBuffer Lib "winmm.dll" (ByVal hWaveIn As System.Int32, ByRef lpWaveInHdr As WAVEHDR, ByVal uSize As System.Int32) As System.Int32
    Declare Function waveInOpen Lib "winmm.dll" (ByRef lphWaveIn As System.Int32, ByVal uDeviceID As System.Int32, ByRef lpFormat As WAVEFORMAT, ByVal dwCallback As System.Int32, ByVal dwInstance As System.Int32, ByVal dwFlags As System.Int32) As System.Int32
    Declare Function waveInClose Lib "winmm.dll" (ByVal hWaveIn As System.Int32) As System.Int32
    Declare Function waveInPrepareHeader Lib "winmm.dll" (ByVal hWaveIn As System.Int32, ByRef lpWaveInHdr As WAVEHDR, ByVal uSize As System.Int32) As System.Int32
    Declare Function waveInUnprepareHeader Lib "winmm.dll" (ByVal hWaveIn As System.Int32, ByRef lpWaveInHdr As WAVEHDR, ByVal uSize As System.Int32) As System.Int32
    Declare Function waveInReset Lib "winmm.dll" (ByVal hWaveIn As System.Int32) As System.Int32
    Declare Function waveInStart Lib "winmm.dll" (ByVal hWaveIn As System.Int32) As System.Int32
    Declare Function waveInStop Lib "winmm.dll" (ByVal hWaveIn As System.Int32) As System.Int32
    Declare Function waveInGetErrorText Lib "winmm.dll" Alias "waveInGetErrorTextA" (ByVal err As System.Int32, ByVal lpText As String, ByVal uSize As System.Int32) As System.Int32

    Structure WAVEFORMAT
        Dim wFormatTag As System.Int16
        Dim nChannels As System.Int16
        Dim nSamplesPerSec As System.Int32
        Dim nAvgBytesPerSec As System.Int32
        Dim nBlockAlign As System.Int16
        Dim nBitsPerSample As System.Int16
        Dim ncbSize As System.Int16
    End Structure

    Structure WAVEHDR
        Dim lpData As System.Int32
        Dim dwBufferLength As System.Int32
        Dim dwBytesRecorded As System.Int32
        Dim dwUser As System.Int32
        Dim dwFlags As System.Int32
        Dim dwLoops As System.Int32
        Dim lpNext As System.Int32
        Dim reserved As System.Int32
    End Structure



End Module

Imports System.Runtime.InteropServices
Public Class Form1
    Inherits System.Windows.Forms.Form

#Region " Windows Form Designer generated code "
'... koodia poistettu
#End Region

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        '***********************************************************************
        ' Ohjelma demoaa äänikortilta näytteen lukua
        ' Windows APIn avulla
        ' muutettu C ja Vb6 koodeista lukuisista läheteistä
        ' Thanks to Gianni Pavan:
        ' http://aulos.calarts.edu/pipermail/music-dsp/2002-November/018573.html
        '************************************************************************
        '
        Dim Channels As System.Int32 = 2    'stereo tai mono
        Dim SampleRate As System.Int32 = 44100 ' CD laatu
        Dim WaveDevice As System.Int32 = 0
        '
        wFormat.wFormatTag = WAVE_FORMAT_PCM
        wFormat.nChannels = Channels
        wFormat.nBitsPerSample = 16
        wFormat.nSamplesPerSec = SampleRate
        wFormat.nBlockAlign = wFormat.nChannels * wFormat.nBitsPerSample / 8
        wFormat.nAvgBytesPerSec = wFormat.nSamplesPerSec * wFormat.nBlockAlign
        wFormat.ncbSize = 0
        '
        Dim hWaveIn As System.Int32 = 0 'kahva äänikortin tuloon
        Dim a As System.Int32
        ' Dim b As System.Int16 = waveInGetNumDevs()' montako äänilaitetta on

        a = waveInOpen(hWaveIn, WaveDevice, wFormat, 0, 0, 0) ' avataan laite eli saadaan hWavein kahva
        ' virheen näyttö
        Dim str As String = New String(" "c, 256)
        waveInGetErrorText(a, str, str.Length)
        'MsgBox(a)

        ' näytebufferin koko
        Dim NUMPTS As System.Int32 = 44100 * 2 * 5 ' 5 s maks näyte
        '
        Dim ptrBuff As IntPtr ' vb.net pointteri
        ' varataan muistialue, johon pointteri osoittaa
        ptrBuff = GlobalAlloc(0, NUMPTS * 2)
        ' laitetaan pointteri struktuurriin, joka annetaan myöhemmin parametrinä
        wHdr.lpData = ptrBuff.ToInt32
        wHdr.dwBufferLength = NUMPTS * 2
        wHdr.dwBytesRecorded = 0
        wHdr.dwUser = 0
        wHdr.dwFlags = 0
        wHdr.dwLoops = 0
        Dim c As Integer = Marshal.SizeOf(wHdr)

        'valmistellaan bufferi
        a = waveInPrepareHeader(hWaveIn, wHdr, c)

        ' ilmoitetaan bufferi äänilaitteelle
        a = waveInAddBuffer(hWaveIn, wHdr, c)

        ' äänilaite täyttää bufferin ääni-datalla
        a = waveInStart(hWaveIn)

        ' Nauhoitetaan 5 s = vain viive
        Dim t1 As Date = Now : Dim t2 As Date : Dim ts As TimeSpan
        While ts.TotalSeconds < 5 ' 5 sek
            t2 = Now
            ts = t2.Subtract(t1)
            Application.DoEvents()
        End While
        'tyhjätään loput bufferiin
        waveInReset(hWaveIn)
        'palautetaan vb.net:iin
        Dim tulos(NUMPTS) As Short ' ääni-data tulee tähän
        'kopioidaan pointterin osoittama muistialue vb.net taulukkoon
        Marshal.Copy(ptrBuff, tulos, 0, tulos.Length)
        ' suljetaan kahva
        waveInClose(hWaveIn)
        'muistialueen vapautus
        GlobalFree(ptrBuff)
        '
        TextBox1.Text = (tulos.Length - 1) / 2.ToString & " ääni-näytettä luettu stereona"

    End Sub
End Class