Option Strict On Imports Un4seen Imports Un4seen.Bass Imports Un4seen.Bass.Bass Imports Un4seen.Bass.AddOn.Enc.BassEnc Imports Un4seen.Bass.AddOn.Enc Public Class Form1 Dim _devrec, _rechandle, _enchandle As Integer Dim _recproc As RECORDPROC Dim aff As clsAffichage Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim DeviceInfos() As BASS_DEVICEINFO 'recuperation de l'enregistreur DeviceInfos = BASS_RecordGetDeviceInfos() For x = 0 To DeviceInfos.Length - 1 If DeviceInfos(x).IsDefault = True Then _devrec = x Exit For End If Next 'paramétrage buffer (bass.dll doit être présent) Dim res As Boolean BASS_Start() res = BASS_SetConfig(BASSConfig.BASS_CONFIG_UPDATEPERIOD, 20) res = BASS_SetConfig(BASSConfig.BASS_CONFIG_REC_BUFFER, 10) 'initialisation du périphérique enregistreur res = BASS_Init(_DevRec, 48000, BASSInit.BASS_DEVICE_DEFAULT, IntPtr.Zero) res = BASS_RecordInit(_DevRec) res = BASS_RecordSetDevice(_devrec) 'debut enregistrement _recProc = Nothing _recProc = New RECORDPROC(AddressOf MyEncProc) _recHandle = BASS_RecordStart(48000, 2, 0, _recProc, IntPtr.Zero) 'enregistrement d'un WAV par exemple _enchandle = BASS_Encode_Start(_rechandle, "test.wav", BASSEncode.BASS_ENCODE_PCM Or BASSEncode.BASS_ENCODE_FP_24BIT Or BASSEncode.BASS_ENCODE_AUTOFREE, Nothing, IntPtr.Zero) 'création du graphique aff New clsAffichage(New Rectangle(0, 0, Me.Width, Me.Height)) With {.Parent Me} End Sub Private Function MyEncProc(ByVal handle As Integer, ByVal buffer As IntPtr, ByVal length As Integer, ByVal user As IntPtr) As Boolean Dim Level As Integer = BASS_ChannelGetLevel(_recHandle) Dim L As Integer = CType(Utils.LowWord32(Level), Integer) Dim R As Integer = CType(Utils.HighWord32(Level), Integer) 'on ajoute ici les valeurs des volumes (voies droite et gauche) aff.AjoutePoints(L, R) 'on affiche le graphique aff.Affiche() Return True End Function End Class Public Class clsAffichage Inherits PictureBox 'bitmap sur lequel dessiner Dim b As Bitmap 'objet graphique Dim g As Graphics 'listes voies gauche et droite Dim l As New List(Of Point) Dim r As New List(Of Point) 'position x sur le graphique Dim pos As Integer Sub New(ByVal rect As Rectangle) 'positionnemlent du picturebox With Me .Left = rect.Left .Top = rect.Top .Width = rect.Width .Height = rect.Height End With 'nouveau bitmap b = New Bitmap(Me.Width, Me.Height) 'assignation de l'objet graphique au bitmap g = Graphics.FromImage(b) End Sub Sub AjoutePoints(ByVal ptL As Integer, ByVal ptR As Integer) 'on ajoute les points dans les deux listes (voie gauche et voie droite) 'remarque : il faut diviser les valeurs du volume par 60 sinon elles dépassent du formulaire pos += 2 l.Add(New Point(pos, Me.Height - CType(ptL / 60, Integer))) r.Add(New Point(pos, Me.Height - CType(ptR / 60, Integer))) 'si le nombre de points dépasse 300 (largeur du formulaire) on efface If pos > 300 Then l.Clear() r.Clear() pos = 0 End If End Sub Sub Affiche() 'effacement du bitmap avec fond noir g.Clear(Color.Black) 'voie gauche 'pour chaque point de la liste on dessine une ligne bleue entre le 'point précédent (x-1) et x For x = 1 To l.Count - 1 g.DrawLine(Pens.Blue, l(x - 1), l(x)) Next 'voie droite (commentée car chevauchement des deux voies sinon...) 'For x = 1 To r.Count - 1 ' g.DrawLine(Pens.Red, r(x - 1), r(x)) 'Next 'affichage Me.Image = CType(b.Clone, Image) End Sub End Class
pour une machineQuelle machine ? Y a-t-il une documentation ?
est reliée à une carte électronique d'acquisitionQuelle carte ?
récuperer le signal de la carte sonQuelle carte ?
Je suis bloqué dans visual basicQuelle version ? Et pourquoi avoir posté dans la section présente VBScript ?
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionc'est une carte d'acquisiton réalisé par des stagiaire dans les années antérieur
Option Strict On Imports Un4seen Imports Un4seen.Bass Imports Un4seen.Bass.Bass Imports Un4seen.Bass.AddOn.Enc.BassEnc Imports Un4seen.Bass.AddOn.Enc Public Class Form1 Dim _devrec, _rechandle, _enchandle As Integer Dim _recproc As RECORDPROC Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim DeviceInfos() As BASS_DEVICEINFO 'recuperation de l'enregistreur DeviceInfos = BASS_RecordGetDeviceInfos() For x = 0 To DeviceInfos.Length - 1 If DeviceInfos(x).IsDefault = True Then _devrec = x Exit For End If Next 'paramétrage buffer (bass.dll doit être présent) Dim res As Boolean BASS_Start() res = BASS_SetConfig(BASSConfig.BASS_CONFIG_UPDATEPERIOD, 20) res = BASS_SetConfig(BASSConfig.BASS_CONFIG_REC_BUFFER, 10) 'initialisation du périphérique enregistreur res = BASS_Init(_DevRec, 48000, BASSInit.BASS_DEVICE_DEFAULT, IntPtr.Zero) res = BASS_RecordInit(_DevRec) res = BASS_RecordSetDevice(_devrec) 'debut enregistrement _recProc = Nothing _recProc = New RECORDPROC(AddressOf MyEncProc) _recHandle = BASS_RecordStart(48000, 2, 0, _recProc, IntPtr.Zero) 'ici, on peut utiliser _recHandle pour l'analyser (données issues de la carte son) 'enregistrement d'un WAV par exemple _encHandle = BASS_Encode_Start(_RecHandle,"test.wav", BASSEncode.BASS_ENCODE_PCM Or BASSEncode.BASS_ENCODE_FP_24BIT Or BASSEncode.BASS_ENCODE_AUTOFREE, Nothing, IntPtr.Zero) End Sub Private Function MyEncProc(ByVal handle As Integer, ByVal buffer As IntPtr, ByVal length As Integer, ByVal user As IntPtr) As Boolean Dim Level As Integer = BASS_ChannelGetLevel(_recHandle) Dim L As Integer = CType(Utils.LowWord32(Level), Integer) Dim R As Integer = CType(Utils.HighWord32(Level), Integer) 'faire ici quelque chose avec le volume (détection debut et fin de son par exemple) '... Return True End Function End Class
Puis-je avoir ton adresse email pour continuer à discuter de cela et puis pour avoir quelque conseils?
'---------------------------------------------------------------------- ' SAA paramêtrable v0 ' repris du Option Explicit 'déclaration obligatoire des variables Public DevHandle As Long 'Handle de la carte son Public Type WaveFormatEx FormatTag As Integer 'format audio 1 pour PCM Channels As Integer '1 pour mono 2 pour stéréo SamplesPerSec As Long 'fréq échantillonage AvgBytesPerSec As Long 'nombre d'octets par seconde = nChannels * nSamplesPerSec * (nBitsPerSample/8) BlockAlign As Integer 'contient la taille totale (en octets) d'un échantillon= nChannels * (nBitsPerSample / 8) BitsPerSample As Integer '8bits ou 16bits ExtraDataSize As Integer 'info utilisée pour les formats non PCM soit 0 pour nous End Type Public Type WaveHdr 'entete du buffer audio lpData As Long 'pointeur vers le buffer dwBufferLength As Long 'longueur du buffer dwBytesRecorded As Long dwUser As Long dwFlags As Long dwLoops As Long lpNext As Long Reserved As Long End Type Public Type WaveInCaps ManufacturerID As Integer 'wMid ProductID As Integer 'wPid DriverVersion As Long 'MMVERSIONS vDriverVersion ProductName(1 To 32) As Byte 'szPname[MAXPNAMELEN] Formats As Long Channels As Integer Reserved As Integer End Type Public Const WAVE_INVALIDFORMAT = &H0& '/* invalid format */ Public Const WAVE_FORMAT_1M08 = &H1& '/* 11.025 kHz, Mono, 8-bit Public Const WAVE_FORMAT_1S08 = &H2& '/* 11.025 kHz, Stereo, 8-bit Public Const WAVE_FORMAT_1M16 = &H4& '/* 11.025 kHz, Mono, 16-bit Public Const WAVE_FORMAT_1S16 = &H8& '/* 11.025 kHz, Stereo, 16-bit Public Const WAVE_FORMAT_2M08 = &H10& '/* 22.05 kHz, Mono, 8-bit Public Const WAVE_FORMAT_2S08 = &H20& '/* 22.05 kHz, Stereo, 8-bit Public Const WAVE_FORMAT_2M16 = &H40& '/* 22.05 kHz, Mono, 16-bit Public Const WAVE_FORMAT_2S16 = &H80& '/* 22.05 kHz, Stereo, 16-bit Public Const WAVE_FORMAT_4M08 = &H100& '/* 44.1 kHz, Mono, 8-bit Public Const WAVE_FORMAT_4S08 = &H200& '/* 44.1 kHz, Stereo, 8-bit Public Const WAVE_FORMAT_4M16 = &H400& '/* 44.1 kHz, Mono, 16-bit Public Const WAVE_FORMAT_4S16 = &H800& '/* 44.1 kHz, Stereo, 16-bit Public Const WAVE_FORMAT_PCM = 1 Public Const WHDR_DONE = &H1& '/* done bit */ Public Const WHDR_PREPARED = &H2& '/* set if this header has been prepared */ Public Const WHDR_BEGINLOOP = &H4& '/* loop start block */ Public Const WHDR_ENDLOOP = &H8& '/* loop end block */ Public Const WHDR_INQUEUE = &H10& '/* reserved for driver */ Public Const WIM_OPEN = &H3BE Public Const WIM_CLOSE = &H3BF Public Const WIM_DATA = &H3C0 Public Declare Function waveInAddBuffer Lib "winmm" (ByVal InputDeviceHandle As Long, ByVal WaveHdrPointer As Long, ByVal WaveHdrStructSize As Long) As Long Public Declare Function waveInPrepareHeader Lib "winmm" (ByVal InputDeviceHandle As Long, ByVal WaveHdrPointer As Long, ByVal WaveHdrStructSize As Long) As Long Public Declare Function waveInUnprepareHeader Lib "winmm" (ByVal InputDeviceHandle As Long, ByVal WaveHdrPointer As Long, ByVal WaveHdrStructSize As Long) As Long Public Declare Function waveInGetNumDevs Lib "winmm" () As Long Public Declare Function waveInGetDevCaps Lib "winmm" Alias "waveInGetDevCapsA" (ByVal uDeviceID As Long, ByVal WaveInCapsPointer As Long, ByVal WaveInCapsStructSize As Long) As Long Public Declare Function waveInOpen Lib "winmm" (WaveDeviceInputHandle As Long, ByVal WhichDevice As Long, ByVal WaveFormatExPointer As Long, ByVal CallBack As Long, ByVal CallBackInstance As Long, ByVal Flags As Long) As Long Public Declare Function waveInClose Lib "winmm" (ByVal WaveDeviceInputHandle As Long) As Long Public Declare Function waveInStart Lib "winmm" (ByVal WaveDeviceInputHandle As Long) As Long Public Declare Function waveInReset Lib "winmm" (ByVal WaveDeviceInputHandle As Long) As Long Public Declare Function waveInStop Lib "winmm" (ByVal WaveDeviceInputHandle As Long) As Long '............................................................................................ ' Les fonctions permettant la sortie sur carte son. '............................................................................................ Public Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long Public Declare Function waveOutGetDevCaps Lib "winmm.dll" Alias "waveOutGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As WaveInCaps, ByVal uSize As Long) As Long Public Declare Function waveOutGetErrorText Lib "winmm.dll" Alias "waveOutGetErrorTextA" (ByVal err As Long, ByVal lpText As String, ByVal uSize As Long) As Long Public Declare Function waveOutOpen Lib "winmm.dll" (lphWaveOut As Long, ByVal uDeviceID As Long, lpFormat As WaveFormatEx, 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, lpWaveOutHdr As WaveHdr, ByVal uSize As Long) As Long Public Declare Function waveOutUnprepareHeader Lib "winmm.dll" (ByVal hWaveOut As Long, lpWaveOutHdr As WaveHdr, ByVal uSize As Long) As Long Public Declare Function waveOutWrite Lib "winmm.dll" (ByVal hWaveOut As Long, lpWaveOutHdr As WaveHdr, ByVal uSize As Long) As Long Public Declare Function waveOutPause Lib "winmm.dll" (ByVal hWaveOut As Long) As Long Public Declare Function waveOutRestart Lib "winmm.dll" (ByVal hWaveOut As Long) As Long Public Declare Function waveOutReset Lib "winmm.dll" (ByVal hWaveOut As Long) As Long Public Declare Sub CopyMemory Lib "kernel32" Alias _ "RtlMoveMemory" (lpDest As Any, lpSource As Any, _ ByVal cbCopy As Long) Public Wave As WaveHdr ' temporisation Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Option Explicit Private InData() As Integer 'tableau qui contiendra les échantillons Dim N2ech As Integer Dim FreqEchant, NumSamples Public Sub Acquisition1() Dim j As Integer 'variable de boucle FreqEchant = 50200 Dim WaveFormat As WaveFormatEx 'type nécessaire aux appels de fonctions wave, voir module2 'pour pouvoir faire une FFT il faut un nombre d'échantillon correspondant 'a une puissance de 2 soit 2^N2ech N2ech = 15 NumSamples = 2 ^ N2ech ReDim InData(0 To NumSamples - 1) 'redimmenssionnement du tableau With WaveFormat .FormatTag = WAVE_FORMAT_PCM '1 .Channels = 1 .SamplesPerSec = FreqEchant .BitsPerSample = 16 .BlockAlign = (.Channels * .BitsPerSample) / 8 .AvgBytesPerSec = .BlockAlign * .SamplesPerSec .ExtraDataSize = 0 End With Call waveInOpen(DevHandle, 0, VarPtr(WaveFormat), 0, 0, 0) If DevHandle = 0 Then Call MsgBox("Wave input device didn't open!", vbExclamation, "Ack!") Exit Sub End If Call waveInStart(DevHandle) Wave.lpData = VarPtr(InData(0)) Wave.dwBufferLength = 2 * NumSamples 'longueur en octets Wave.dwFlags = 0 Call waveInPrepareHeader(DevHandle, VarPtr(Wave), Len(Wave)) Call waveInAddBuffer(DevHandle, VarPtr(Wave), Len(Wave)) Do Loop Until ((Wave.dwFlags And WHDR_DONE) = WHDR_DONE) Call waveInUnprepareHeader(DevHandle, VarPtr(Wave), Len(Wave)) CopyMemory InData(0), ByVal Wave.lpData, NumSamples 'maintenant InData contient tous les échantillons waveInReset (DevHandle) waveInClose (DevHandle) End Sub Public Sub RecupCartes() ' Liste les cartes son dans le PC Dim Caps As WaveInCaps, Which As Long, str As String For Which = 0 To waveInGetNumDevs - 1 Call waveInGetDevCaps(Which, VarPtr(Caps), Len(Caps)) If Caps.Formats And WAVE_FORMAT_1M16 Then '16-bit mono devices str = "vous avez une : " & StrConv(Caps.ProductName, vbUnicode) Call MsgBox(str) End If Next End Sub Public Sub CommandButton1_Click() Acquisition1 Dim i, x As Double For i = 1 To 4096 Range("A" & i).Value = InData(i - 1) / 10 x = 80 / (NumSamples + 1) Range("B" & i).Value = x * i Range("J"&i).Value = Next Range("H2").Value = NumSamples Range("H1").Value = FreqEchant Range("H3").Value = (1 / FreqEchant) End Sub