Die Community zu .NET und Classic VB.
Menü

Tipp-Upload: VB 5/6 0174: Resampling von Audiodaten

 von 

Über den Tipp  

Dieser Tippvorschlag ist noch unbewertet.

Der Vorschlag ist in den folgenden Kategorien zu finden:

  • Mathematik
  • Multimedia

Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
Resampling, Samplerate, Downsampling, Upsampling

Damit er übernommen werden kann, müssen noch Änderungen daran vorgenommen werden. Sofern Sie der Autor sind, können Sie sich anmelden, um die Liste einzusehen.

Der Vorschlag wurde erstellt am: 10.01.2008 21:10.
Die letzte Aktualisierung erfolgte am 23.02.2008 15:12.

Zurück zur Übersicht

Beschreibung  

Um eine Wavedatei in Ihrer Tonhöhe zu verändern oder um die Samplerate der Wavedaten bei gleichbleibender Spieldauer und Tonhöhe zu verändern, verwendet man verschiedene Interpolationsverfahren. Hier ein Beispielcode für Resampling mit einer einfachen linearen Interpolation. In der oberen PictureBox ist die Ausgangskurve, in der mittleren die resampelte Kurve und in der unteren sind beide Kurven zusammen, als vertikaler Strich pro Sample zu sehen.

Schwierigkeitsgrad

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

VarPtr (ArrPtr)

Download:

Download des Beispielprojektes [3,32 KB]

' Dieser Source stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.

' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!

' ------------- Anfang Projektdatei Projekt1.vbp -------------

' --------- Anfang Formular "Form1" alias Form1.frm  ---------

' Steuerelement: Beschriftungsfeld "Label1" auf Panel1
' Steuerelement: Bildfeld-Steuerelement "Picture2"
' Steuerelement: Bildfeld-Steuerelement "Picture1"
' Steuerelement: Beschriftungsfeld "Label4" auf Panel1
' Steuerelement: Beschriftungsfeld "Label3" auf Panel1
' Steuerelement: Beschriftungsfeld "Label2" auf Panel1
' Steuerelement: Bildfeld-Steuerelement "Panel1"
' Steuerelement: Textfeld "Text1" (Index von 0 bis 3) auf Panel1
' Steuerelement: Bildfeld-Steuerelement "Picture3"

Option Explicit

Private mSrcWav()   As Integer ' enthält nur Raw-Audiodaten
Private mSrcSPS     As Long
Private mSrcSamples As Long
Private mSrcPeriods As Double

Private mSrcStep    As Double
Private mDstStep    As Double
Private t           As Double

Private mDstWav()   As Integer
Private mDstSPS     As Long
Private Const Pi    As Double = 3.14159265358979

Private Declare Function ArrPtr Lib "msvbvm60" _
                         Alias "VarPtr" ( _
                         ByRef pArr() As Any) As Long

Private Sub Form_Load()

    ' enthält ein PictureBox (Panel1) das als Container
    ' für 4 Label und 4 TextBoxen dient
    ' Align = 1 'Oben ausrichten

    Label1.Caption = "SrcSPS: "
    Label2.Caption = "DstSPS: "
    Label3.Caption = "Samples: "
    Label4.Caption = "Perioden: "

    ReDim mSrcWav(0)
    ReDim mDstWav(0)

    ' 44100 ': eine typische Samplerate
    ' 30000 ': eine willkürliche Samplerate
    mSrcSPS = 40000
    mDstSPS = 10000
    mSrcSamples = 100
    mSrcPeriods = 2#

    Call Initialize
    Call UpdateText1

End Sub

Private Sub Initialize()

    ' die Ausgangswave erstellen
    Call CreateSinWav(mSrcWav, mSrcSamples, mSrcPeriods)

    ' die Zielwave durch Resampling mit Linearer Interpolation erstellen
    Call ReSample(mDstWav, mDstSPS, mSrcWav, mSrcSPS)

End Sub

Private Sub UpdateText1()

    Text1(0).Text = CStr(mSrcSPS)
    Text1(1).Text = CStr(mDstSPS)
    Text1(2).Text = CStr(mSrcSamples)
    Text1(3).Text = CStr(mSrcPeriods)

End Sub

Private Sub CreateSinWav(wav() As Integer, ByVal Samples As Long, ByVal Periods As Double)

    ReDim wav(0 To Samples - 1)

    Dim i  As Long
    Dim A As Long
    Dim Phi As Double
    Dim PhiStep As Double
    Dim PhiMax As Double

    A = (2 ^ 15 - 1) * 0.9 ' , bzw. A = 30000

    PhiMax = Periods * 2 * Pi
    PhiStep = PhiMax / (Samples - 1)

    For Phi = 0 To PhiMax Step PhiStep
        wav(i) = CInt(A * Sin(Phi))
        i = i + 1
    Next

    ' Alternative Methode
    ' PhiStep = (Periods * 2 * Pi) / (samples - 1)
    '    For i = 0 To Samples - 1
    '        wav(i) = CInt(A * Sin(PhiStep * i))
    '    Next

End Sub

Public Sub ReSample(DstWav() As Integer, ByVal DstSps As Long, _
                    SrcWav() As Integer, ByVal SrcSPS As Long)

    Dim i     As Long
    Dim DstUB As Long
    Dim SrcUB As Long

    Dim j1 As Double
    Dim j2 As Double
    Dim j3 As Double

    Dim y1 As Double
    Dim y3 As Double

    mSrcStep = 1 / SrcSPS
    mDstStep = 1 / DstSps

    SrcUB = UBound(SrcWav)
    DstUB = ((SrcUB) * mSrcStep / mDstStep)

    ' Das Zielarray dimensionieren
    ReDim DstWav(0 To DstUB)

    ' den ersten Wert so zuweisen
    DstWav(0) = SrcWav(0)

    For i = 1 To DstUB - 1

        t = i * mDstStep  ' Zeit in der Zieldatei
        j2 = (t / mSrcStep) - 0
        j1 = (Int(j2))   ' die Stelle des niedrigeren Wertes
        j3 = j1 + 1      ' die Stelle des höheren Wertes

        ' den unteren Wert aus SrcWav rauslesen
        y1 = CDbl(SrcWav(CLng(j1)))

        ' den oberen Wert aus SrcWav rauslesen
        y3 = CDbl(SrcWav(CLng(j3)))
        DstWav(i) = (LinIPol(y1, y3, j1, j2, j3))
    Next

    DstWav(DstUB) = SrcWav(SrcUB)

End Sub

Private Function LinIPol(ByVal y1 As Double, _
                         ByVal y3 As Double, _
                         ByVal x1 As Double, _
                         ByVal x2 As Double, _
                         ByVal x3 As Double) As Double

    ' errechnet einen Wert y2 zu dem Wert x2 durch lineare Interpolation
    If (x3 - x1) = 0 Then
        LinIPol = y1
    Else
        LinIPol = y1 + (y3 - y1) / (x3 - x1) * (x2 - x1)
    End If

End Function

Private Sub Form_Resize()

    Dim L As Single, t As Single, W As Single, H As Single
    Dim brdr As Single
    Dim nPB As Long

    brdr = 8 * 15
    nPB = 3 ' Anzahl an PictureBoxen übereinander

    L = brdr: t = Panel1.Height + brdr
    W = Me.ScaleWidth - L - brdr
    H = (Me.ScaleHeight - t - brdr) / nPB - (2 * brdr / nPB)

    If W > 0 And H >= 0 Then Call Picture1.Move(L, t, W, H)

    t = t + H + brdr

    If W > 0 And H >= 0 Then Call Picture2.Move(L, t, W, H)

    t = t + H + brdr

    If W > 0 And H >= 0 Then Call Picture3.Move(L, t, W, H)

End Sub

Private Sub Picture1_Paint()

    Call Picture1.Cls

    If ArrPtr(mSrcWav) <> 0 Then Call DrawWav(mSrcWav, mSrcStep, Picture1)

End Sub

Private Sub Picture2_Paint()

    Call Picture2.Cls

    If ArrPtr(mDstWav) <> 0 Then Call DrawWav(mDstWav, mDstStep, Picture2)

End Sub

Private Sub Picture3_Paint()

    Call Picture3.Cls

    Picture3.ForeColor = 0

    If ArrPtr(mSrcWav) <> 0 Then Call DrawWav(mSrcWav, mSrcStep, Picture3)
    Picture3.ForeColor = vbRed

    If ArrPtr(mDstWav) <> 0 Then Call DrawWav(mDstWav, mDstStep, Picture3)

End Sub

Private Sub DrawWav(wav() As Integer, tstep As Double, aPB As PictureBox)

    Dim x1 As Long, y1 As Long
    Dim x2 As Long, y2 As Long
    Dim stepX As Double, stepY As Double
    Dim i As Long, wi As Integer
    Dim brdr As Single
    Dim tMax As Double
    Dim xfact As Double

    brdr = 8 * 15
    y1 = aPB.ScaleHeight / 2

    tMax = UBound(mSrcWav) / mSrcSPS

    xfact = (aPB.ScaleWidth - 2 * brdr) / tMax
    stepY = (aPB.ScaleHeight - brdr) / 65535

    For i = 0 To UBound(wav)
        wi = -wav(i)
        t = i * tstep
        x2 = brdr + t * xfact
        y2 = stepY * wi + aPB.ScaleHeight \ 2
        x1 = x2
        aPB.Line (x1, y1)-(x2, y2)
    Next

End Sub

Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)

    Dim dblVal As Double

    Select Case KeyCode

    Case vbKeyPageDown, vbKeyPageUp, vbKeyReturn

        If IsNumeric(Text1(Index).Text) Then
            dblVal = CDbl(Text1(Index).Text)
        Else

            Exit Sub

        End If

        Select Case KeyCode

        Case vbKeyPageUp
            dblVal = dblVal + 1

        Case vbKeyPageDown
            dblVal = dblVal - 1

        Case Else

        End Select

        Select Case Index

        Case 0: mSrcSPS = CLng(dblVal)
        Case 1: mDstSPS = CLng(dblVal)
        Case 2: mSrcSamples = CLng(dblVal)
        Case 3: mSrcPeriods = dblVal

        End Select

        Call UpdateText1
        Call Initialize

        Picture1.Refresh
        Picture2.Refresh
        Picture3.Refresh

    End Select

End Sub

' ---------- Ende Formular "Form1" alias Form1.frm  ----------

' -------------- Ende Projektdatei Projekt1.vbp --------------

	

Diskussion  

Diese Funktion ermöglicht es, Fragen, die die Veröffentlichung des Tipps betreffen, zu klären, oder Anregungen und Verbesserungsvorschläge einzubringen. Nach der Veröffentlichung des Tipps werden diese Beiträge nicht weiter verlinkt. Allgemeine Fragen zum Inhalt sollten daher hier nicht geklärt werden.

Um eine Diskussion eröffnen zu können, müssen sie angemeldet sein.