Resampler reechantillonner un fragment de donnee

Commenter

Contenu du snippet

Concretement :
On a une liste de départ de taille a, avec des valeurs allant de 0 à x.
On souhaite transformer la taille de cette liste de a à b avec des valeur allant de -128 à 127
Voila le code qu'il vous faut :)
Interet ? Resampling d'echantillons sonore (ou autres).

Cas concret : vous faites une sinusoide quelconque (ici en 1000 points) et souhaitez en faire un fichier son d'une seconde et demi 16 bits 11025:
Dim OutTbll()
Dim t As Long
For i = 1 To 1000
UnTableau(i) = Cos(i / 30) + 1
Next i
f = AudioFormat(UnTableau(), 1000, 11025, -32768, 65535, 1500, OutTbll())
'y'a plus qu'a enregistrer le contenu de OutTbl() dans un fichier (ou de l'envoyer vers la carte son)
For i = 1 to UBound(OutTbl())
'tralala
Next u

Source / Exemple : 


Function AudioFormat(ByRef RawData(), LenRawData As Long, BtPerSec As Long, ValMin As Double, ValMax As Double, DureeFragment As Long, FormatedData()) As Boolean
'AudioFormat
'Par Proger, version beta
'converti le fragment d'echantillons de RawData en suite de sample
'LenRawData est egal a la longueur de la liste (nb d'echantillons)
'BtPerSec est egal au samplage voulu : 11025, 22050, 44100 (cas du PCM) ou autres...
'Dureefragment : durée en millisecondes que devra faire la RawData (cas du PCM)
'ValMin et ValMax : valeur mini et maxi des samples (pour la normalisation)
'(Cas PCM : 8 bits = type Byte , 16 bits = type Integer)
'type Byte : ValMin = 0 et ValMax = 255
'type Integer : ValMin = -32768 et ValMax = 65535
'Type Long : ValMin = -2147483648 et ValMax = 2147483647
'renvoie True si la conversion a réussi, False dans le cas contraire
'
'ATTENTION :  les valeurs de RawData DOIVENT ETRE SUPERIEUR A 0 !
Dim DecLst() As Double
Dim TempClist()
Dim nSample As Long
Dim NechPsample As Double

nSample = Int(DureeFragment / 1000 * BtPerSec)

NechPsample = nSample / LenRawData
If NechPsample > 1 Then
    'Augmentation du nombre de sample de sortie par rapport a ceux de RawData
    'nécessite une interpolation pour créer les samples
    'calcul du décalage:
    ReDim DecLst(nSample) As Double
    For i = 1 To nSample
        t = i / NechPsample
        DecLst(i) = t - Fix(t)
    Next i
    'création de la liste de sortie!
    ReDim TempClist(nSample)
    For i = 1 To nSample
        TempClist(i) = RawData(Int((i - 1) / NechPsample)) * DecLst(i) + RawData(Int((i - 1) / NechPsample) + 1) * (1 - DecLst(i))
    Next i
    
    'purge de la mémoire
    ReDim DecLst(1) As Double
    
    'remplissage de la liste de sortie avec les valeurs
    MaxL = L_Max(nSample, TempClist())
    ReDim FormatedData(nSample)
    For i = 1 To nSample
        FormatedData(i) = Int(ValMax * TempClist(i) / MaxL) + ValMin
    Next i

    'purge de la mémoire
    ReDim TempClist(1) 'As Double

ElseIf NechPsample = 1 Then
    'copie directement les données en sample
    MaxL = L_Max(nSample, TempClist())
    ReDim FormatedData(nSample)
    For i = 1 To nSample
        FormatedData(i) = Int(ValMax * TempClist(i) / MaxL) + ValMin
    Next i

ElseIf NechPsample = 0 Then
    'erreur !
    AudioFormat = False: Exit Function

Else
    'Reechantillonnage avec moins de sample qu'il n'y a dans la RawData
    'nécessite une moyenne (ici pondéré) pour créer les samples
    'evidemment ça bousille le son original

    'calcul de la pondération de chaque echantillon
    'en effet, il y aura un echantillon a cheval sur 2 samples.
    'il faut donc calculer le "poids" des 2 moitié de l'echantillon
    'dans le calcul de la moyenne d'échantillons pas sample
    ReDim DecLst(nSample) As Double
    t = 0
    For i = 1 To nSample
        t = t + NechPsample
        DecLst(i) = t - Fix(t)
    Next i
    'création de la liste de sortie!
    ReDim TempClist(nSample) 'As Double
    For i = 1 To nSample
        lmoy = 0
        'idx du premier ech complet a utilisé pour le sample
        echp = Int((i - 1) * (1 / NechPsample)) + 1
        'val du morceau de ech du début (pondéré)
        lmoy = RawData(echp - 1) * (1 - DecLst(i - 1))
        'cumul des val des ech complet
        For j = echp To Int(i * (1 / NechPsample))
            lmoy = lmoy + RawData(j)
        Next j
        'idx du dernier ech, incomplet, pour le sample
        echf = Int(i * (1 / NechPsample)) + 1
        If echf > LenRawData Then echf = LenRawData
        'val pondéré de cet ech
        lmoy = lmoy + RawData(echf) * (DecLst(i))
        'moyenne et valeur du sample
        lmoy = lmoy / (1 / NechPsample)
        TempClist(i) = lmoy
    Next i
    
    'purge de la mémoire
    ReDim DecLst(1) As Double
    
    'remplissage de la liste de sortie avec les valeurs
    'max de la liste : le max ici sera le max dans l'autre. utile pour
    'la conversion en produit en croix.
    'en gros, c'est une normalisation
    MaxL = L_Max(nSample, TempClist())
    ReDim FormatedData(nSample) 'As Byte
    For i = 1 To nSample
        FormatedData(i) = Int(ValMax * TempClist(i) / MaxL) + ValMin
    Next i

    'purge de la mémoire
    ReDim TempClist(1) 'As Double

End If
AudioFormat = True
'fin de audioformat
End Function

Private Function L_Max(tt, ByRef ls()) As Double
'trouve la valeur maxi d'une liste
a = 0
For i = 1 To tt
   If ls(i) > a Then a = ls(i)
Next i
L_Max = a
End Function

Conclusion :


Ce code marche largement mieux lorsque il faut augmenter la taille de l'échantillonnage plutôt que la réduire (il y a apparition de parasites. Je traque le bug)

Ceci est la première version, je pense en ré-envoyer une plus optimisé et déboguer plus tard.

PS : je sais pas si un code du même genre existe deja, je n'en ai pas vu.

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 (Proger)