Sujet Précédent Sujet Suivant

Oscilloscope et spectre carte son VB

asticool03 - 29 avril 2013 à 09:06
 Utilisateur anonyme - 30 avril 2013 à 15:40
Bonjour à tous,
Je vous expose mon probléme cela fait maintenant 2 semaines que j'ai fini un projet qui est de récupérer le signal de sortie d'une machine (andérométre) qui permet de tester la vibration des roulements!
Le probléme qui se pose est la chose suivante: j'ai réussi à faire exactement ce que je voulais sur excel VBA mais il faut que j'arrive a faire la même chose en Visual basic et c'est bien là le probléme...
voila mon code VBA et le resultat attendu! si deja je pouvais réussir à obtenir juste les données qui sortent de la carte son aprés je me débrouille en fesait la FFT et le reste !

le module: 

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)


le code : 

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 = 51200

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 frequence As Integer
frequence = 10000 / 2048        'fréquence d'un echantillon du spectre
Dim i, x As Double
For i = 1 To 4096
    Range("A" & i).Value = InData(i - 1) / 10
    x = 1 / FreqEchant
    Range("B" & i).Value = (x * i) * 1000
Next
For i = 1 To 2048
Range("W" & i).Value = frequence * i
Next
    Macro11
    Macroreel
    Macroimag
    Macromodule
    Range("N2").Value = NumSamples
    Range("N1").Value = FreqEchant
    Range("N3").Value = (1 / FreqEchant)
End Sub


le resultat:

/img


merci de votre aide ='(

15 réponses

Réponse 1 / 15
Utilisateur anonyme
29 avril 2013 à 12:42
Bonjour,
Dans ton code il te manque les modules:
Macro11
Macroreel
Macroimag
Macromodule
non?


Cordialement


CF2i - Guadeloupe
Ingénierie Informatique
0
Réponse 2 / 15
asticool03
29 avril 2013 à 13:10
oui ils son't dans un utre module =) tkt pas l'autre module n'as rien d'important =)
0
Réponse 3 / 15
Utilisateur anonyme
29 avril 2013 à 13:29
J'en ai trouvé mais en VB6 et en C....


Cordialement


CF2i - Guadeloupe
Ingénierie Informatique
0
Réponse 4 / 15
Utilisateur anonyme
29 avril 2013 à 13:45
Tiens, j'au vu CA qui analyse le spectre de fichiers wav, ça pourrait être utile...


Cordialement


CF2i - Guadeloupe
Ingénierie Informatique
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 15
asticool03
29 avril 2013 à 13:48
ce n'est pas trop ce que je recherche car ce post est vraiment dédié à partir d'un fichier wave alors que moi mon probléme c'est récupérer l'information de la carte son.
0
Réponse 6 / 15
Utilisateur anonyme
29 avril 2013 à 16:28
Bonjour,

il faut que j'arrive a faire la même chose en Visual basic


Quel Visual Basic ? Vb.net ou VB6 ?

Ceci dit, tu utilises essentiellement des appels à l'API Windows. Normalement, si cela passe en VBA, cela devrait passer en VB. Si c'est vraiment en VB.net, tu dois remplacer le type Long de C par l'équivalent en VB.net. Si ucfoutu passe par ici, il va me corriger ou compléter.
0
Réponse 7 / 15
Utilisateur anonyme
29 avril 2013 à 16:28
0
Réponse 8 / 15
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
29 avril 2013 à 18:45
Bonjour, cmarcotte,
Je confirme la nécessité d'utiliser d'autres types que les longs.
Il devra à mon avis utiliser des structures de VB.Net en lieu et place des types personnalisés de VB6 ou VBA
Ca, c'est pour la partie déclarations uniquement, bien évidemment. Sans préjudice, donc, de la nécessité d'autres transpositions éventuelles que j'ignore (je ne suis pas vb.nettiste).


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
0
Réponse 9 / 15
Utilisateur anonyme
30 avril 2013 à 02:18
Bonjour ucfoutu,

Je confirme la nécessité d'utiliser d'autres types que les longs.


Merci pour la confirmation.

Il devra à mon avis utiliser des structures de VB.Net en lieu et place des types personnalisés de VB6 ou VBA
Ca, c'est pour la partie déclarations uniquement, bien évidemment. Sans préjudice, donc, de la nécessité d'autres transpositions éventuelles que j'ignore (je ne suis pas vb.nettiste).


Justement, c'est rendu-là que j'ai un gros doute et que je me demande si c'est vraiment en Visual Basic.net. Pourquoi se serait-il "entraîné" en VBA, si c'est pour faire une application en VB.net ? Mais bon, le décalage horaire aidant, vous allez probablement lire sa réponse avant.
0
Réponse 10 / 15
Utilisateur anonyme
30 avril 2013 à 02:42
Bonjour cmarcotte,
J'avais fait un minimum de recherches j'ai trouvé de bons exemples en C mais rien en VB.net, mais ça devrait pouvoir se faire, j'ai bien vu un exemple en VB6 également.


Cordialement


CF2i - Guadeloupe
Ingénierie Informatique
0
Réponse 11 / 15
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
30 avril 2013 à 07:46
Pourquoi se serait-il "entraîné" en VBA, si c'est pour faire une application en VB.net ?

Tu as bien raison de te poser cette question, cmarcotte.
Et tu as deviné, comme moi, je m'en doute, le sens exact et "précis" de ceci :
j'ai réussi à faire exactement ce que je voulais sur excel VBA mais il faut que j'arrive a faire la même chose en Visual basic et c'est bien là le probléme...


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
0
Réponse 12 / 15
asticool03
30 avril 2013 à 08:03
Bonjour déja merci pour vos réponse,
Depuis hier j'ai réussi a transposé en VB6 le probléme été que si je copié ce code de VBA en VB supérieur a la version 6 alors le code ne marchais pas tandis que avec VB6 aucun soucis =) Vraiment bizarre bonne journée en tout cas et merci encore !
0
Réponse 13 / 15
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
30 avril 2013 à 08:25
Qui dit transposition dit deux choses :
- maîtrise sans faille du code que '"on" a écrit dans un langage
(car on ne peut transposer que ce que l'on maîtrise)
- connaissance suffisante de l'autre langage. Et relis déjà ce qui t'a été dit plus haut à propos des types et des structures. Il est assez étonnant que ce soit quelqu'un comme moi (qui ne connais RIEN de VB.Net) qui ait à t'en faire la remarque !


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
0
Réponse 14 / 15
Utilisateur anonyme
30 avril 2013 à 15:20
Bonjour,
Voici ton code sans erreurs: 
'Tu ajoutes un module à ton projet, Module1 donc:

Option Explicit On 'déclaration obligatoire des variables
Module Module1
    Public DevHandle As Integer 'Handle de la carte son

    Public Structure WaveFormatEx
        Public FormatTag As Integer        'format audio 1 pour PCM
        Public Channels As Integer         '1 pour mono 2 pour stéréo
        Public SamplesPerSec As Long       'fréq échantillonage
        Public AvgBytesPerSec As Long      'nombre d'octets par seconde = nChannels * nSamplesPerSec * (nBitsPerSample/8)
        Public BlockAlign As Integer       'contient la taille totale (en octets) d'un échantillon= nChannels * (nBitsPerSample / 8)
        Public BitsPerSample As Integer    '8bits ou 16bits
        Public ExtraDataSize As Integer    'info utilisée pour les formats non PCM soit 0 pour nous
    End Structure

    Public Structure WaveHdr             'entete du buffer audio
        Public lpData As Long              'pointeur vers le buffer
        Public dwBufferLength As Long      'longueur du buffer
        Public dwBytesRecorded As Long
        Public dwUser As Long
        Public dwFlags As Long
        Public dwLoops As Long
        Public lpNext As Long
        Public Reserved As Long
    End Structure

    Public Structure WaveInCaps
        Public ManufacturerID As Integer      'wMid
        Public ProductID As Integer       'wPid
        Public DriverVersion As Long       'MMVERSIONS vDriverVersion
        Public ProductName() As Byte 'szPname[MAXPNAMELEN]
        Public Formats As Long
        Public Channels As Integer
        Public Reserved As Integer
    End Structure

    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" (ByVal 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, ByVal 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" (ByVal lphWaveOut As Long, ByVal uDeviceID As Long, ByVal 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, ByVal lpWaveOutHdr As WaveHdr, ByVal uSize As Long) As Long
    Public Declare Function waveOutUnprepareHeader Lib "winmm.dll" (ByVal hWaveOut As Long, ByVal lpWaveOutHdr As WaveHdr, ByVal uSize As Long) As Long
    Public Declare Function waveOutWrite Lib "winmm.dll" (ByVal hWaveOut As Long, ByVal 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 Function VarPtr Lib "msvbvm60.dll" Alias "VarPtr" (ByVal lpObject As Object) As Long

    Public Declare Sub CopyMemory Lib "kernel32" Alias _
    "RtlMoveMemory" (ByVal lpDest As Object, ByVal lpSource As Object, _
    ByVal cbCopy As Long)

    Public Wave As WaveHdr

    ' temporisation
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
End Module



'Dans la form principale:
Option Explicit On
Public Class Form1

    Private InData() As Integer 'tableau qui contiendra les échantillons
    Dim N2ech As Integer
    Dim FreqEchant, NumSamples

    Public Sub Acquisition1()

        Dim j As Integer = 0 'variable de boucle
        FreqEchant = 51200

        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), 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 = Nothing
        Dim 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)
                str = System.Text.Encoding.Unicode.GetString(Caps.ProductName)
                Call MsgBox(str)
            End If
        Next


    End Sub
    Public Sub CommandButton1_Click()
        Acquisition1()
        Dim frequence As Integer
        frequence = 10000 / 2048        'fréquence d'un echantillon du spectre
        Dim i, x As Double
        For i = 1 To 4096
            'A convertir     Range("A" & i).Value = InData(i - 1) / 10
            x = 1 / FreqEchant
            'A convertir     Range("B" & i).Value = (x * i) * 1000
        Next
        For i = 1 To 2048
            'A convertir Range("W" & i).Value = frequence * i
        Next
        '??? Macro11()
        '??? Macroreel()
        '??? Macroimag()
        '??? Macromodule()
        'A convertir Range("N2").Value = NumSamples
        'A convertir Range("N1").Value = FreqEchant
        'A convertir Range("N3").Value = (1 / FreqEchant)
    End Sub

End Class


Il reste à savoir ce que tu mettais dans les cellules de excel (j'ai pas trop compris).


Cordialement


CF2i - Guadeloupe
Ingénierie Informatique
0
Réponse 15 / 15
Utilisateur anonyme
30 avril 2013 à 15:40
Rectification :
Après un Option Strict à ON: 

'Tu ajoutes un module à ton projet, Module1 donc:

Option Explicit On 'déclaration obligatoire des variables
Option Strict On
Module Module1
    Public DevHandle As Integer 'Handle de la carte son

    Public Structure WaveFormatEx
        Public FormatTag As Integer        'format audio 1 pour PCM
        Public Channels As Integer         '1 pour mono 2 pour stéréo
        Public SamplesPerSec As Long       'fréq échantillonage
        Public AvgBytesPerSec As Long      'nombre d'octets par seconde = nChannels * nSamplesPerSec * (nBitsPerSample/8)
        Public BlockAlign As Integer       'contient la taille totale (en octets) d'un échantillon= nChannels * (nBitsPerSample / 8)
        Public BitsPerSample As Integer    '8bits ou 16bits
        Public ExtraDataSize As Integer    'info utilisée pour les formats non PCM soit 0 pour nous
    End Structure

    Public Structure WaveHdr             'entete du buffer audio
        Public lpData As Long              'pointeur vers le buffer
        Public dwBufferLength As Long      'longueur du buffer
        Public dwBytesRecorded As Long
        Public dwUser As Long
        Public dwFlags As Long
        Public dwLoops As Long
        Public lpNext As Long
        Public Reserved As Long
    End Structure

    Public Structure WaveInCaps
        Public ManufacturerID As Integer      'wMid
        Public ProductID As Integer       'wPid
        Public DriverVersion As Long       'MMVERSIONS vDriverVersion
        Public ProductName() As Byte 'szPname[MAXPNAMELEN]
        Public Formats As Long
        Public Channels As Integer
        Public Reserved As Integer
    End Structure

    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" (ByVal 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, ByVal 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" (ByVal lphWaveOut As Long, ByVal uDeviceID As Long, ByVal 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, ByVal lpWaveOutHdr As WaveHdr, ByVal uSize As Long) As Long
    Public Declare Function waveOutUnprepareHeader Lib "winmm.dll" (ByVal hWaveOut As Long, ByVal lpWaveOutHdr As WaveHdr, ByVal uSize As Long) As Long
    Public Declare Function waveOutWrite Lib "winmm.dll" (ByVal hWaveOut As Long, ByVal 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 Function VarPtr Lib "msvbvm60.dll" Alias "VarPtr" (ByVal lpObject As Object) As Long

    Public Declare Sub CopyMemory Lib "kernel32" Alias _
    "RtlMoveMemory" (ByVal lpDest As Object, ByVal lpSource As Object, _
    ByVal cbCopy As Long)

    Public Wave As WaveHdr

    ' temporisation
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
End Module



'Dans la form principale:
Option Explicit On
Option Strict On
Public Class Form1

    Private InData() As Integer 'tableau qui contiendra les échantillons
    Dim N2ech, FreqEchant, NumSamples As Integer

    Public Sub Acquisition1()

        Dim j As Integer = 0 'variable de boucle
        FreqEchant = 51200

        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 = CInt(2 ^ N2ech)

        ReDim InData(0 To CInt(NumSamples - 1)) 'redimmenssionnement du tableau


        With WaveFormat
            .FormatTag = WAVE_FORMAT_PCM '1
            .Channels = 1
            .SamplesPerSec = FreqEchant
            .BitsPerSample = 16
            .BlockAlign = CInt((.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 = CLng(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), Wave.lpData, CLng(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 = Nothing
        Dim Which As Long, str As String

        For Which = 0 To waveInGetNumDevs - 1
            Call waveInGetDevCaps(Which, VarPtr(Caps), Len(Caps))
            If CBool(Caps.Formats And WAVE_FORMAT_1M16) Then '16-bit mono devices
                'str = "vous avez une : " & StrConv(Caps.ProductName, vbUnicode)
                str = System.Text.Encoding.Unicode.GetString(Caps.ProductName)
                Call MsgBox(str)
            End If
        Next


    End Sub
    Public Sub CommandButton1_Click()
        Acquisition1()
        Dim frequence As Integer
        frequence = CInt(10000 / 2048)        'fréquence d'un echantillon du spectre
        Dim i, x As Double
        For i = 1 To 4096
            'A convertir     Range("A" & i).Value = InData(i - 1) / 10
            x = 1 / FreqEchant
            'A convertir     Range("B" & i).Value = (x * i) * 1000
        Next
        For i = 1 To 2048
            'A convertir Range("W" & i).Value = frequence * i
        Next
        '??? Macro11()
        '??? Macroreel()
        '??? Macroimag()
        '??? Macromodule()
        'A convertir Range("N2").Value = NumSamples
        'A convertir Range("N1").Value = FreqEchant
        'A convertir Range("N3").Value = (1 / FreqEchant)
    End Sub

End Class


- Si ça fonctionne laisse le nous savoir...

Cordialement


CF2i - Guadeloupe
Ingénierie Informatique
0

Discussions similaires

jeu solitaire avec carte
faluma972 -
coucou747 -

6 réponses
Générateur de cartes de visites
spectroman -
spectroman -

9 réponses
Tutoriels et javascript pour tirage de cartes sur internet
Ange07_200 -
ange07_200 -

3 réponses
créer un tirage de tarot divinatoire
copersil -
bultez -

12 réponses
Tirage aléatoire de carte
Eliot7500 -
ucfoutu -

16 réponses
Rejoignez-nous