Tipp-Upload: VB 5/6 0174: Resampling von Audiodaten
von OlimilO
Ü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.
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
|
Verwendete API-Aufrufe: VarPtr (ArrPtr) |
Download: |
' 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.