Class audio (mci wav mmio)

Commenter

Contenu du snippet

J'archive cette classe que je qualifie d'obsolète, elle peut toujours être utile c'est pour cela que je la partage. Elle a fait son chemin pis j'ai la flemme de continuer son adaptation en VB.NET.

Source / Exemple : 


Imports System
Imports System.IO
Imports Microsoft.VisualBasic
Imports System.Threading
Imports System.Runtime.InteropServices
Imports xxx.ApplicationAudio.MCI

Namespace ApplicationAudio
    Public Class MCI
        ' mmsystem.h 1.4 00/01/03 Copyright 1998,1999,2000 Heiko Eissfeldt */
        ' translation C++ > Vb6 > "Vb.net" by Duke49 from VBFrance
        '
        ' Result code definition */
        Public Shared MMRESULT As Integer
        Public Shared MCIERROR As Long
        Public Shared PLAYING_END As Boolean  ' local flag to track playback status

        ' Various error values */
        Friend Const MAXERRORLENGTH = 256 ' Maximum length of error message */
        Friend Const TIMERR_NOERROR = MMSYSERR_NOERROR
        Friend Const TIMERR_NOCANDO = 97
        Friend Const MMSYSERR_BASE = 0
        Friend Const MMSYSERR_NOERROR = 0                          ' no error
        Friend Const MMSYSERR_ERROR = (MMSYSERR_BASE + 1)          ' unspecified error
        Friend Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE + 2)    ' device ID out of range
        Friend Const MMSYSERR_NOTENABLED = (MMSYSERR_BASE + 3)     ' driver failed enable
        Friend Const MMSYSERR_ALLOCATED = (MMSYSERR_BASE + 4)      ' device already allocated
        Friend Const MMSYSERR_INVALHANDLE = (MMSYSERR_BASE + 5)    ' device handle is invalid
        Friend Const MMSYSERR_NODRIVER = (MMSYSERR_BASE + 6)       ' no device driver present
        Friend Const MMSYSERR_NOMEM = (MMSYSERR_BASE + 7)          ' memory allocation error
        Friend Const MMSYSERR_NOTSUPPORTED = (MMSYSERR_BASE + 8)   ' function isn't supported
        Friend Const MMSYSERR_BADERRNUM = (MMSYSERR_BASE + 9)      ' error value out of range
        Friend Const MMSYSERR_INVALFLAG = (MMSYSERR_BASE + 10)     ' invalid flag passed
        Friend Const MMSYSERR_INVALPARAM = (MMSYSERR_BASE + 11)    ' invalid parameter passed
        Friend Const MMSYSERR_HANDLEBUSY = (MMSYSERR_BASE + 12)    ' handle being used simultaneously on another thread (eg callback) */
        Friend Const MMSYSERR_INVALIDALIAS = (MMSYSERR_BASE + 13)  ' specified alias not found
        Friend Const MMSYSERR_BADDB = (MMSYSERR_BASE + 14)         ' bad registry database
        Friend Const MMSYSERR_KEYNOTFOUND = (MMSYSERR_BASE + 15)   ' registry key not found
        Friend Const MMSYSERR_READERROR = (MMSYSERR_BASE + 16)     ' registry read error
        Friend Const MMSYSERR_WRITEERROR = (MMSYSERR_BASE + 17)    ' registry write error
        Friend Const MMSYSERR_DELETEERROR = (MMSYSERR_BASE + 18)   ' registry delete error
        Friend Const MMSYSERR_VALNOTFOUND = (MMSYSERR_BASE + 19)   ' registry value not found
        Friend Const MMSYSERR_NODRIVERCB = (MMSYSERR_BASE + 20)    ' driver does not call DriverCallback
        Friend Const MMSYSERR_MOREDATA = (MMSYSERR_BASE + 21)      ' more data to be returned
        Friend Const MMSYSERR_LASTERROR = (MMSYSERR_BASE + 21)     ' last error in range

        ' Wave out device handle */
        Public Shared HWAVEOUT As Long

        ' MCI device handle */
        Public Shared MCIDEVICEID As Integer

        ' Have the system choose a wave device */
        Friend Const WAVE_MAPPER = -1& '((Integer.MaxValue) - 1) ' -1&
        Friend Const WAVE_FORMAT_PCM = 1
        Friend Const WAVE_INVALIDFORMAT = &H0& '/* invalid format */
        Friend Const WAVE_FORMAT_1M08 = &H1& '/* 11.025 kHz, Mono, 8-bit
        Friend Const WAVE_FORMAT_1S08 = &H2& '/* 11.025 kHz, Stereo, 8-bit
        Friend Const WAVE_FORMAT_1M16 = &H4& '/* 11.025 kHz, Mono, 16-bit
        Friend Const WAVE_FORMAT_1S16 = &H8& '/* 11.025 kHz, Stereo, 16-bit
        Friend Const WAVE_FORMAT_2M08 = &H10& '/* 22.05 kHz, Mono, 8-bit
        Friend Const WAVE_FORMAT_2S08 = &H20& '/* 22.05 kHz, Stereo, 8-bit
        Friend Const WAVE_FORMAT_2M16 = &H40& '/* 22.05 kHz, Mono, 16-bit
        Friend Const WAVE_FORMAT_2S16 = &H80& '/* 22.05 kHz, Stereo, 16-bit
        Friend Const WAVE_FORMAT_4M08 = &H100& '/* 44.1 kHz, Mono, 8-bit
        Friend Const WAVE_FORMAT_4S08 = &H200& '/* 44.1 kHz, Stereo, 8-bit
        Friend Const WAVE_FORMAT_4M16 = &H400& '/* 44.1 kHz, Mono, 16-bit
        Friend Const WAVE_FORMAT_4S16 = &H800& '/* 44.1 kHz, Stereo, 16-bit 

        ' wave device errors */
        Friend Const WAVERR_BASE = 32
        Friend Const WAVERR_BADFORMAT = (WAVERR_BASE + 0)      ' unsupported wave format
        Friend Const WAVERR_STILLPLAYING = (WAVERR_BASE + 1)   ' still something playing
        Friend Const WAVERR_UNPREPARED = (WAVERR_BASE + 2)     ' header not prepared
        Friend Const WAVERR_SYNC = (WAVERR_BASE + 3)           ' device is synchronous
        Friend Const WAVERR_LASTERROR = (WAVERR_BASE + 3)      ' last error in range

        ' Specify the type of wave event callback */
        Friend Const CALLBACK_FUNCTION = &H30000   ' to set up a callback to a function
        Friend Const CALLBACK_EVENT = &H50000  ' to set up a callback to a event

        ' Messages sent to the waveOut callback function */
        Friend Const MM_WOM_OPEN = &H3BB   ' waveform output
        Friend Const MM_WOM_CLOSE = &H3BC
        Friend Const MM_WOM_DONE = &H3BD
        Friend Const WOM_OPEN = MM_WOM_OPEN
        Friend Const WOM_CLOSE = MM_WOM_CLOSE
        Friend Const WOM_DONE = MM_WOM_DONE

        <StructLayout(LayoutKind.Explicit)> _
        Public Structure MMTIME
            <FieldOffset(0)> Public wType As Long
            <FieldOffset(4)> Public ms As Long
            <FieldOffset(4)> Public sample As Long
            <FieldOffset(4)> Public cb As Long
            <FieldOffset(4)> Public ticks As Long
            <FieldOffset(4)> Public smtpeHour As Byte
            <FieldOffset(5)> Public smpteMin As Byte
            <FieldOffset(6)> Public smpteSec As Byte
            <FieldOffset(7)> Public smpteFrame As Byte
            <FieldOffset(8)> Public smpteFps As Byte
            <FieldOffset(9)> Public smpteDummy As Byte
            <FieldOffset(10)> Public smptePad0 As Byte
            <FieldOffset(11)> Public smptePad1 As Byte
            <FieldOffset(4)> Public midiSongPtrPos As Long
        End Structure

        <StructLayout(LayoutKind.Sequential)> _
        Public Structure MMCKINFO
            Public ckid As Integer
            Public ckSize As Integer
            Public fccType As Integer
            Public dwDataOffset As Integer
            Public dwFlags As Integer
        End Structure

        <StructLayout(LayoutKind.Sequential)> _
        Public Structure MMIOINFO
            Public dwFlags As Integer
            Public fccIOProc As Integer
            Public pIOProc As Integer
            Public wErrorRet As Integer
            Public htask As Integer
            Public cchBuffer As Integer
            Public pchBuffer As String
            Public pchNext As String
            Public pchEndRead As String
            Public pchEndWrite As String
            Public lBufOffset As Integer
            Public lDiskOffset As Integer
            Public adwInfo1 As Integer
            Public adwInfo2 As Integer
            Public adwInfo3 As Integer
            Public adwInfo4 As Integer
            Public dwReserved1 As Integer
            Public dwReserved2 As Integer
            Public hmmio As Integer
        End Structure

        ' The wave buffer header used by waveOut functions */
        <StructLayout(LayoutKind.Sequential)> _
        Public Structure WAVEHDR
            Dim lpData As String
            Dim dwBufferLength As Long
            Dim dwBytesRecorded As Long
            Dim dwUser As Long
            Dim dwFlags As Long
            Dim dwLoops As Long
            Shared lpNext As WAVEHDR
            Dim reserved As Long
        End Structure

        ' WAVEHDR.dwFlags */
        Friend Const WHDR_DONE = &H1       ' done bit
        Friend Const WHDR_PREPARED = &H2   ' set if this header has been prepared
        Friend Const WHDR_BEGINLOOP = &H4  ' loop start block
        Friend Const WHDR_ENDLOOP = &H8    ' loop end block
        Friend Const WHDR_INQUEUE = &H10   ' reserved for driver

        ' Structure used in querying the capabilities of a wave device */
        <StructLayout(LayoutKind.Sequential)> _
        Public Structure WAVEOUTCAPS
            Dim wMid As Integer                       ' ManufacturerID
            Dim wPid As Integer                       ' ProductID
            Dim vDriverVersion As Long            ' MMVERSIONS vDriverVersion
            <VBFixedArray(32)> Dim szPname As Char  ' szPname[MAXPNAMELEN]
            Dim dwFormats As Long
            Dim wReserved1 As Integer
            Dim dwSupport As Long
        End Structure
        <StructLayout(LayoutKind.Sequential)> _
        Public Structure WAVEINCAPS
            Dim ManufacturerID As Integer
            Dim ProductID As Integer
            Dim DriverVersion As Long
            <VBFixedArray(32)> Dim ProductName As Byte
            Dim Formats As Long
            Dim Channels As Integer
            Dim Reserved As Integer
        End Structure

        ' Old wave format structure */
        <StructLayout(LayoutKind.Sequential)> _
        Public Structure WAVEFORMAT
            Dim wFormatTag As Integer
            Dim nChannels As Integer
            Dim nSamplesPerSec As Long
            Dim nAvgBytesPerSec As Long
            Dim nBlockAlign As Integer
        End Structure

        ' PCM wave format structure */
        <StructLayout(LayoutKind.Sequential)> _
        Public Structure PCMWAVEFORMAT
            Dim wf As WAVEFORMAT
            Dim wBitsPerSample As Integer
        End Structure

        ' Wave format structure (used by dsound.h) */
        <StructLayout(LayoutKind.Sequential)> _
        Public Structure WAVEFORMATEX
            Dim wFormatTag As Integer
            Dim nChannels As Integer
            Dim nSamplesPerSec As Long
            Dim nAvgBytesPerSec As Long
            Dim nBlockAlign As Integer
            Dim wBitsPerSample As Integer
            Dim cbSize As Integer
        End Structure

        ' Friend Constants used as arguments and flags to mciSendCommand() */

        ' CD device type */
        Friend Const MCI_STRING_OFFSET = 512
        Friend Const MCI_DEVTYPE_CD_AUDIO = (MCI_STRING_OFFSET + 4)

        ' MCI commands */
        Friend Const MCI_OPEN = &H803
        Friend Const MCI_CLOSE = &H804
        Friend Const MCI_PLAY = &H806
        Friend Const MCI_STOP = &H808
        Friend Const MCI_PAUSE = &H809
        Friend Const MCI_SET = &H80D
        Friend Const MCI_STATUS = &H814
        Friend Const MCI_RESUME = &H855

        ' Flags for MCI commands */
        Friend Const MCI_NOTIFY = &H1
        Friend Const MCI_WAIT = &H2
        Friend Const MCI_FROM = &H4
        Friend Const MCI_TO = &H8
        Friend Const MCI_TRACK = &H10

        ' Flags for MCI Play command */
        Friend Const MCI_OPEN_SHAREABLE = &H100
        Friend Const MCI_OPEN_ELEMENT = &H200
        Friend Const MCI_OPEN_TYPE_ID = &H1000
        Friend Const MCI_OPEN_TYPE = &H2000

        ' Flags for MCI Status command */
        Friend Const MCI_STATUS_ITEM = &H100
        Friend Const MCI_STATUS_LENGTH = &H1
        Friend Const MCI_STATUS_POSITION = &H2
        Friend Const MCI_STATUS_NUMBER_OF_TRACKS = &H3
        Friend Const MCI_STATUS_MODE = &H4
        Friend Const MCI_STATUS_MEDIA_PRESENT = &H5
        Friend Const MCI_STATUS_TIME_FORMAT = &H6
        Friend Const MCI_STATUS_READY = &H7
        Friend Const MCI_STATUS_CURRENT_TRACK = &H8

        ' Flags for MCI Set command */
        Friend Const MCI_SET_DOOR_OPEN = &H100
        Friend Const MCI_SET_DOOR_CLOSED = &H200
        Friend Const MCI_SET_TIME_FORMAT = &H400

        ' MCI device status flags */
        Friend Const MCI_MODE_NOT_READY = (MCI_STRING_OFFSET + 12)
        Friend Const MCI_MODE_STOP = (MCI_STRING_OFFSET + 13)
        Friend Const MCI_MODE_PLAY = (MCI_STRING_OFFSET + 14)
        Friend Const MCI_MODE_RECORD = (MCI_STRING_OFFSET + 15)
        Friend Const MCI_MODE_SEEK = (MCI_STRING_OFFSET + 16)
        Friend Const MCI_MODE_PAUSE = (MCI_STRING_OFFSET + 17)
        Friend Const MCI_MODE_OPEN = (MCI_STRING_OFFSET + 18)

        ' Friend Constants used to specify MCI time formats */
        Friend Const MCI_FORMAT_MILLISECONDS = 0
        Friend Const MCI_FORMAT_HMS = 1
        Friend Const MCI_FORMAT_MSF = 2
        Friend Const MCI_FORMAT_FRAMES = 3
        Friend Const MCI_FORMAT_BYTES = 8
        Friend Const MCI_FORMAT_SAMPLES = 9
        Friend Const MCI_FORMAT_TMSF = 10

        ' What type of timer to set */
        Friend Const TIME_ONESHOT = &H0   ' program timer for single event */
        Friend Const TIME_PERIODIC = &H1   ' program for continuous periodic event */

        'Public Shared ReadOnly MCI_MSF_MINUTE As Integer = MCI_MAKE_MSF("m", "", "")
        'Public Shared ReadOnly MCI_MSF_SECOND As Integer = MCI_MAKE_MSF("", "s", "")
        'Public Shared ReadOnly MCI_MSF_FRAME As Integer = MCI_MAKE_MSF("", "", "f")

        'Public Shared Function MCI_MAKE_MSF(ByVal m, ByVal s, ByVal f) As Long
        '    Return (CType(CType(AscW(m), Byte), Long) Or _
        '    (CType(AscW(s), Integer) << 8) Or _
        '   (CType(AscW(f), Integer) << 16))
        'End Function

        ' Structures passed as arguments to mciSendCommand() */
        <StructLayout(LayoutKind.Sequential)> _
        Public Structure MCI_OPEN_PARMS
            Dim dwCallback As Long
            Shared wDeviceID = MCIDEVICEID
            Dim lpstrDeviceType As String
            Dim lpstrElementName As String
            Dim lpstrAlias As String
        End Structure
        <StructLayout(LayoutKind.Sequential)> _
        Public Structure MCI_SET_PARMS
            Dim dwCallback As Long
            Dim dwTimeFormat As Long
            Dim dwAudio As Long
        End Structure
        <StructLayout(LayoutKind.Sequential)> _
        Public Structure MCI_PLAY_PARMS
            Dim dwCallback As Long
            Dim dwFrom As Long
            Dim dwTo As Long
        End Structure
        <StructLayout(LayoutKind.Sequential)> _
        Public Structure MCI_STATUS_PARMS
            Dim dwCallback As Long
            Dim dwReturn As Long
            Dim dwItem As Long
            Dim dwTrack As Long
        End Structure

        ' Convert a string to a 4 byte multimedia code */
        Public Shared Function mmioFOURCC(ByVal ch0 As Char, ByVal ch1 As Char, ByVal ch2 As Char, ByVal ch3 As Char) As Long
            Return (CType(CType(AscW(ch0), Byte), Long) Or _
            (CType(AscW(ch1), Byte) << 8) Or _
            (CType(AscW(ch2), Byte) << 16) Or _
            (CType(AscW(ch3), Byte) << 24))
        End Function

        ' Multimedia timer function declarations */
        Public Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As TimerCallback, ByVal dwUser As Long, ByVal uFlags As Long) As Long
        Public Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long
        Public Declare Function timeBeginPeriod Lib "winmm.dll" (ByVal uPeriod As Integer) As Long
        Public Declare Function timeEndPeriod Lib "winmm.dll" (ByVal uPeriod As Integer) As Long

        ' The waveOut* function declarations */
        Public Declare Function waveOutGetNumDevs Lib "winmm.dll" Alias "waveOutGetNumDevs" () As Long
        Public Declare Function waveOutGetDevCaps Lib "winmm.dll" Alias "waveOutGetDevCapsA" (ByVal uDeviceID As Long, ByVal lpCaps As Long, ByVal uSize As Long) As Long
        Public Declare Function waveOutGetErrorText Lib "winmm.dll" Alias "waveOutGetErrorTextA" (ByVal err_Renamed As Integer, ByVal lpText As String, ByVal uSize As Integer) As Integer
        Public Declare Function waveOutOpen Lib "winmm.dll" (ByRef lphWaveOut As Long, ByVal uDeviceID As Long, ByVal lpFormat As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
        Public Declare Function waveOutClose Lib "winmm.dll" (ByVal hWaveOut As Long) As Long
        Public Declare Function waveOutPrepareHeader Lib "winmm.dll" (ByVal hWaveOut As Long, ByRef lpWaveOutHdr As WAVEHDR, ByVal uSize As Long) As Long
        Public Declare Function waveOutUnprepareHeader Lib "winmm.dll" (ByVal hWaveOut As Long, ByRef lpWaveOutHdr As WAVEHDR, ByVal uSize As Long) As Long
        Public Declare Function waveOutWrite Lib "winmm.dll" (ByVal hWaveOut As Long, ByRef lpWaveOutHdr As WAVEHDR, ByVal uSize As Long) As Long
        Public Declare Function waveOutPrepareHeaderPtr Lib "winmm.dll" (ByVal hWaveIn As IntPtr, ByVal lpWaveInHdr As Integer, ByVal uSize As Integer) As Integer
        Public Declare Function waveOutPause Lib "winmm.dll" (ByVal hWaveOut As IntPtr) As Integer
        Public Declare Function waveOutRestart Lib "winmm.dll" (ByVal hWaveOut As IntPtr) As Integer
        Public Declare Function waveOutReset Lib "winmm.dll" (ByVal hWaveIn As IntPtr) As Integer
        Public Declare Function waveOutGetPosition Lib "winmm.dll" (ByVal hWaveOut As IntPtr, ByRef lpInfo As MMTIME, ByVal uSize As Integer) As Integer
        Public Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As IntPtr, ByVal dwVolume As Long) As Integer
        Public Declare Function waveOutGetVolume Lib "winmm.dll" (ByVal uDeviceID As IntPtr, ByRef lpdwVolume As Integer) As Integer
        Public Declare Function waveOutBreakLoop Lib "winmm.dll" (ByVal hWaveOut As Integer) As Integer

        ' The MMIO functions delcartions */
        Public Declare Function mmioClose Lib "winmm.dll" (ByVal hmmio As IntPtr, ByVal uFlags As Integer) As Integer
        Public Declare Function mmioDescend Lib "winmm.dll" (ByVal hmmio As IntPtr, ByRef lpck As MMCKINFO, ByRef lpckParent As MMCKINFO, ByVal uFlags As Integer) As Integer
        Public Declare Function mmioDescendParent Lib "winmm.dll" Alias "mmioDescend" (ByVal hmmio As IntPtr, ByRef lpck As MMCKINFO, ByVal x As Integer, ByVal uFlags As Integer) As Integer
        Public Declare Ansi Function mmioOpen Lib "winmm.dll" Alias "mmioOpenA" (ByVal szFileName As String, ByRef lpmmioinfo As MMIOINFO, ByVal dwOpenFlags As Integer) As IntPtr
        Public Declare Function mmioRead Lib "winmm.dll" (ByVal hmmio As IntPtr, ByVal pch As Integer, ByVal cch As Integer) As Integer
        Public Declare Function mmioReadString Lib "winmm.dll" Alias "mmioRead" (ByVal hmmio As IntPtr, ByVal pch() As Byte, ByVal cch As Integer) As Integer
        Public Declare Function mmioSeek Lib "winmm.dll" (ByVal hmmio As IntPtr, ByVal lOffset As Integer, ByVal iOrigin As Integer) As Integer
        Public Declare Ansi Function mmioStringToFOURCC Lib "winmm.dll" Alias "mmioStringToFOURCCA" (ByVal sz As String, ByVal uFlags As Integer) As Integer
        Public Declare Function mmioAscend Lib "winmm.dll" (ByVal hmmio As IntPtr, ByRef lpck As MMCKINFO, ByVal uFlags As Integer) As Integer

        ' Others
        Public Declare Sub CopyWaveFormatFromBytes Lib "kernel32" Alias "RtlMoveMemory" (ByRef dest As WAVEFORMAT, ByVal source() As Byte, ByVal cb As Integer)
        Public Declare Sub CopyWaveHeaderFromPointer Lib "kernel32" Alias "RtlMoveMemory" (ByRef dest As WAVEHDR, ByVal source As Integer, ByVal cb As Integer)
        Public Declare Function IsBadWritePtr Lib "kernel32" (ByVal lp As Integer, ByVal ucb As Integer) As Integer
        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

        ' The MCI command interface */
        Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpszCommand As String, ByVal lpszReturnString As String, ByVal cchReturnLength As Long, ByVal hwndCallback As Long) As Long
        Public Declare Function mciSendCommand Lib "winmm.dll" Alias "mciSendCommandA" (ByVal wDeviceID As Long, ByVal uMessage As Long, ByVal dwParam1 As Long, ByRef dwParam2 As Long) As Long
        Public Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long

        ' VB6 Ptr's - Dosent work correctly */
        Public Function VarPtr(ByVal e) As Long
            Dim GC As GCHandle = GCHandle.Alloc(e, GCHandleType.Pinned)
            Dim NewGC As Integer = GC.AddrOfPinnedObject.ToInt32
            GC.Free()
            Return NewGC
        End Function
        Public Function StructPtr(ByVal StructureName As Object) As Long
            Dim pt As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(StructureName))
            Marshal.StructureToPtr(StructureName, pt, True)
            Return pt.ToInt64
        End Function
    End Class

    Public Module Fonctions
        ' timer callback function prototype */
        Dim mCallBack As WaveDelegate = AddressOf WaveCallBack
        Delegate Sub WaveDelegate(ByVal uTimerID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As WAVEHDR, ByVal dw2 As Long)
        Sub WaveCallBack(ByVal uTimerID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As WAVEHDR, ByVal dw2 As Long)
            Select Case uMsg
                Case MM_WOM_OPEN
                    Main.Text = "MCI OPEN"
                Case WOM_DONE
                    Main.Text = "MCI END"
                    PLAYING_END = True
                Case Else
                    Main.Text = "MCI " & uMsg
                    REM   .WriteLine(uMsg)
            End Select
        End Sub

        Public Sub Play(ByVal Frequency As Single, ByVal Seconds As Single)
            Dim wavFormat As WAVEFORMATEX
            Dim wavHead As WAVEHDR
            Dim hWaveOut As Long

            With wavFormat
                .wFormatTag = WAVE_FORMAT_PCM
                .nChannels = 2
                .wBitsPerSample = 16
                .nSamplesPerSec = 44100
                .nBlockAlign = .nChannels * (.wBitsPerSample >> 3)
                .nAvgBytesPerSec = .nBlockAlign '* .nSamplesPerSec
                .cbSize = 0
            End With

            Dim BufferSamples As Integer = wavFormat.nSamplesPerSec * Seconds
            Dim BufferBytes As Integer = BufferSamples * wavFormat.nBlockAlign
            Dim pMem As IntPtr
            'allocate memory on the heap
            pMem = Marshal.AllocHGlobal(BufferBytes)

            With wavHead
                .lpData = pMem.ToLong
                .dwBufferLength = BufferBytes
            End With

            waveOutOpen(hWaveOut, WAVE_MAPPER, StructPtr(wavFormat), StructPtr(mCallBack), 0, CALLBACK_FUNCTION)
            waveOutPrepareHeader(hWaveOut, wavHead, Len(wavHead))
            PLAYING_END = False

            ' fill buffer with specific frequency
            Dim SamplesPerCycle As Double = wavFormat.nSamplesPerSec / Frequency
            For i As Integer = 0 To BufferSamples - 1
                ' 16-bit samples are stored as 2's-complement signed integers, ranging from -32768 to 32767
                Dim RotationPercent As Double = (i Mod SamplesPerCycle) / SamplesPerCycle
                Dim RotationRadians As Double = RotationPercent * Math.PI * 2
                Dim SampleValue As Integer = Math.Sin(RotationRadians) * Integer.MaxValue
                ' blocks are 4 bytes - 2 bytes for left channel then 2 bytes for right channel
                ' left channel
                Marshal.WriteInteger(pMem, i * wavFormat.nBlockAlign, SampleValue)
                ' right channel
                Marshal.WriteInteger(pMem, (i * wavFormat.nBlockAlign) + 2, SampleValue)
            Next

            ' play buffer
            waveOutWrite(hWaveOut, wavHead, Len(wavHead))

            Do While (Not PLAYING_END)

            Loop

            waveOutUnprepareHeader(hWaveOut, wavHead, Len(wavHead))
            waveOutClose(hWaveOut)

            'free memory we allocated on the heap
            Marshal.FreeHGlobal(pMem)

        End Sub

    End Module
End Namespace

Conclusion :


Source a retravailler pour le .Net.

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (Duke49)