Results 1 to 10 of 10

Thread: VB6.0 – Sound and DirectXSound Tutorial

Threaded View

  1. Mar 16th, 2006, 10:15 AM #7
    CVMichael
    CVMichael is offline

    Thread Starter
    PowerPoster
    Join Date
    Feb 2002
    Location
    Canada, Toronto
    Posts
    5,803

    Re: Tutorial under construction

    Here is an example on how it looks like when you convert by the nearest index:

    In the previous image it's converting from 8000 Hz sample rate to 22050 Hz sample rate.
    The black line (with black dots) is the original sound that is at 8000 Hz, and the yellow is the converted sound at 22050 Hz.

    The better way to do it, is by calculating the value by using the line intersection formula, like this:

    Using the line intersection formula, you can find the exact value that it should be even when the destination sample position does not match the source sample position.

    Here is a sample image on how it looks like when you use line intersection formula:


    And here is the code to convert using the line intersection formula:
    VB Code:
    1. Public Function FindYForX(ByVal X As Double, ByVal X1 As Double, ByVal Y1 As Double, _

    2.         ByVal X2 As Double, ByVal Y2 As Double) As Double

    3.     

    4.     Dim M As Double, B As Double

    5.     

    6.     M = (Y1 - Y2) / (X1 - X2)

    7.     B = Y1 - M * X1

    8.     

    9.     FindYForX = M * X + B

    10. End Function

    11.  
    12. Public Function ConvertWave16ReSample(Buff() As Integer, ByVal FromSample As Long, ByVal ToSample As Long, ByVal Stereo As Boolean) As Integer()

    13.     Dim K As Long, Lx As Long, RX As Long

    14.     Dim Ret() As Integer, Per As Double, NewSize As Long

    15.     

    16.     If Not Stereo Then

    17.         NewSize = Fix((UBound(Buff) + 1) * ToSample / FromSample + 0.5)

    18.         ReDim Ret(NewSize - 1)

    19.         

    20.         For K = 0 To UBound(Ret) - 1

    21.             Per = K / UBound(Ret)

    22.             

    23.             Lx = Fix(UBound(Buff) * Per)

    24.             

    25.             Ret(K) = FindYForX(UBound(Buff) * Per, Lx, Buff(Lx), Lx + 1, Buff(Lx + 1))

    26.         Next K

    27.         

    28.         Ret(UBound(Ret)) = Buff(UBound(Buff))

    29.     Else

    30.         NewSize = Fix((UBound(Buff) + 1) * ToSample / FromSample + 0.5)

    31.         NewSize = NewSize - (NewSize Mod 2)

    32.         ReDim Ret(NewSize - 1)

    33.         

    34.         For K = 0 To UBound(Ret) Step 2

    35.             Per = K / (UBound(Ret) + 2)

    36.             

    37.             ' Left channel

    38.             Lx = Fix(UBound(Buff) * Per / 2#) * 2

    39.             Ret(K + 0) = FindYForX(UBound(Buff) * Per, Lx, Buff(Lx), Lx + 2, Buff(Lx + 2))

    40.             

    41.             ' Right channel

    42.             RX = Lx + 1

    43.             Ret(K + 1) = FindYForX(UBound(Buff) * Per + 1, RX, Buff(RX), RX + 2, Buff(RX + 2))

    44.         Next K

    45.         

    46.         Ret(UBound(Ret) - 1) = Buff(UBound(Buff) - 1)

    47.         Ret(UBound(Ret)) = Buff(UBound(Buff))

    48.     End If

    49.     

    50.     ConvertWave16ReSample = Ret

    51. End Function

    52.  
    53. Public Function ConvertWave8ReSample(Buff() As Byte, ByVal FromSample As Long, ByVal ToSample As Long, ByVal Stereo As Boolean) As Byte()

    54.     Dim K As Long, Lx As Long, RX As Long

    55.     Dim Ret() As Byte, Per As Double, NewSize As Long

    56.     

    57.     If Not Stereo Then

    58.         NewSize = Fix((UBound(Buff) + 1) * ToSample / FromSample + 0.5)

    59.         ReDim Ret(NewSize - 1)

    60.         

    61.         For K = 0 To UBound(Ret) - 1

    62.             Per = K / UBound(Ret)

    63.             

    64.             Lx = Fix(UBound(Buff) * Per)

    65.             

    66.             Ret(K) = FindYForX(UBound(Buff) * Per, Lx, Buff(Lx), Lx + 1, Buff(Lx + 1))

    67.         Next K

    68.         

    69.         Ret(UBound(Ret)) = Buff(UBound(Buff))

    70.     Else

    71.         NewSize = Fix((UBound(Buff) + 1) * ToSample / FromSample + 0.5)

    72.         NewSize = NewSize - (NewSize Mod 2)

    73.         ReDim Ret(NewSize - 1)

    74.         

    75.         For K = 0 To UBound(Ret) Step 2

    76.             Per = K / (UBound(Ret) + 2)

    77.             

    78.             ' Left channel

    79.             Lx = Fix(UBound(Buff) * Per / 2#) * 2

    80.             Ret(K + 0) = FindYForX(UBound(Buff) * Per, Lx, Buff(Lx), Lx + 2, Buff(Lx + 2))

    81.             

    82.             ' Right channel

    83.             RX = Lx + 1

    84.             Ret(K + 1) = FindYForX(UBound(Buff) * Per + 1, RX, Buff(RX), RX + 2, Buff(RX + 2))

    85.         Next K

    86.         

    87.         Ret(UBound(Ret) - 1) = Buff(UBound(Buff) - 1)

    88.         Ret(UBound(Ret)) = Buff(UBound(Buff))

    89.     End If

    90.     

    91.     ConvertWave8ReSample = Ret

    92. End Function

    Converting from any format to any other format
    With all the functions together from this post and previous post, you can convert from any format to any other format. They work fine if the format is static, but if the format changes often, it is difficult to make a lot of if statements to choose what function to call in each case.

    That's why I made things easier. The following function converts to all formats possible using all the previous functions.
    The input must be a Byte Array to Integer Array regardless of the Bits Per Sample for the sound. The return array will always be Byte Array for 8 bit return sound, and Integer Array for 16 bit return sound.
    VB Code:
    1. Public Function ConvertWave(Buffer As Variant, FromFormat As WAVEFORMATEX, ToFormat As WAVEFORMATEX) As Variant

    2.     Dim Buffer16() As Integer

    3.     Dim Buffer8() As Byte

    4.     

    5.     Dim RetBuff16() As Integer

    6.     Dim RetBuff8() As Byte

    7.     

    8.     If FromFormat.nBitsPerSample = 16 Then

    9.         Select Case VarType(Buffer)

    10.         Case (vbArray Or vbByte)

    11.             Buffer8 = Buffer

    12.             Buffer16 = Convert16_8To16(Buffer8)

    13.             Erase Buffer8

    14.         Case (vbArray Or vbInteger)

    15.             Buffer16 = Buffer

    16.         Case Else

    17.             ConvertWave = vbEmpty

    18.             Exit Function

    19.         End Select

    20.         

    21.         If ToFormat.nBitsPerSample = 8 Then

    22.             RetBuff8 = ConvertWave16to8(Buffer16)

    23.             Erase Buffer16

    24.             

    25.             GoTo To8Bit ' JUMP TO 8 BIT

    26.         ElseIf ToFormat.nBitsPerSample = 16 Then

    27.             RetBuff16 = Buffer16

    28.             Erase Buffer16

    29.         Else

    30.             ConvertWave = vbEmpty

    31.             Exit Function

    32.         End If

    33. To16Bit:

    34.         

    35.         If FromFormat.nChannels = 1 And ToFormat.nChannels = 2 Then

    36.             RetBuff16 = ConvertWaveMonoToStereo16(RetBuff16)

    37.         ElseIf FromFormat.nChannels = 2 And ToFormat.nChannels = 1 Then

    38.             RetBuff16 = ConvertWaveStereoToMono16(RetBuff16)

    39.         ElseIf FromFormat.nChannels <> ToFormat.nChannels Then

    40.             ConvertWave = vbEmpty

    41.             Exit Function

    42.         End If

    43.         

    44.         If FromFormat.lSamplesPerSec <> ToFormat.lSamplesPerSec Then

    45.             Select Case FromFormat.lSamplesPerSec / ToFormat.lSamplesPerSec

    46.             Case 0.25

    47.                 RetBuff16 = ConvertWave16MultiplySamplesBy2(RetBuff16, ToFormat.nChannels = 2)

    48.                 RetBuff16 = ConvertWave16MultiplySamplesBy2(RetBuff16, ToFormat.nChannels = 2)

    49.             Case 0.5

    50.                 RetBuff16 = ConvertWave16MultiplySamplesBy2(RetBuff16, ToFormat.nChannels = 2)

    51.             Case 2

    52.                 RetBuff16 = ConvertWave16DivideSamplesBy2(RetBuff16, ToFormat.nChannels = 2)

    53.             Case 4

    54.                 RetBuff16 = ConvertWave16DivideSamplesBy2(RetBuff16, ToFormat.nChannels = 2)

    55.                 RetBuff16 = ConvertWave16DivideSamplesBy2(RetBuff16, ToFormat.nChannels = 2)

    56.             Case Else

    57.                 RetBuff16 = ConvertWave16ReSample(RetBuff16, FromFormat.lSamplesPerSec, ToFormat.lSamplesPerSec, ToFormat.nChannels = 2)

    58.             End Select

    59.         End If

    60.         

    61.         ConvertWave = RetBuff16

    62.     ElseIf FromFormat.nBitsPerSample = 8 Then

    63.         Select Case VarType(Buffer)

    64.         Case (vbArray Or vbByte)

    65.             Buffer8 = Buffer

    66.         Case (vbArray Or vbInteger)

    67.             Buffer16 = Buffer

    68.             

    69.             ReDim Buffer8((UBound(Buffer16) + 1) * 2 - 1)

    70.             CopyMemory Buffer8(0), Buffer(16), UBound(Buffer8) + 1

    71.             

    72.             Erase Buffer16

    73.         Case Else

    74.             ConvertWave = vbEmpty

    75.             Exit Function

    76.         End Select

    77.         

    78.         If ToFormat.nBitsPerSample = 16 Then

    79.             RetBuff16 = ConvertWave8to16(Buffer8)

    80.             Erase Buffer8

    81.             

    82.             GoTo To16Bit ' JUMP TO 16 BIT

    83.         ElseIf ToFormat.nBitsPerSample = 8 Then

    84.             RetBuff8 = Buffer8

    85.             Erase Buffer8

    86.         Else

    87.             ConvertWave = vbEmpty

    88.             Exit Function

    89.         End If

    90. To8Bit:

    91.         

    92.         If FromFormat.nChannels = 1 And ToFormat.nChannels = 2 Then

    93.             RetBuff8 = ConvertWaveMonoToStereo8(RetBuff8)

    94.         ElseIf FromFormat.nChannels = 2 And ToFormat.nChannels = 1 Then

    95.             RetBuff8 = ConvertWaveStereoToMono8(RetBuff8)

    96.         ElseIf FromFormat.nChannels <> ToFormat.nChannels Then

    97.             ConvertWave = vbEmpty

    98.             Exit Function

    99.         End If

    100.         

    101.         If FromFormat.lSamplesPerSec <> ToFormat.lSamplesPerSec Then

    102.             Select Case FromFormat.lSamplesPerSec / ToFormat.lSamplesPerSec

    103.             Case 0.25

    104.                 RetBuff8 = ConvertWave8MultiplySamplesBy2(RetBuff8, ToFormat.nChannels = 2)

    105.                 RetBuff8 = ConvertWave8MultiplySamplesBy2(RetBuff8, ToFormat.nChannels = 2)

    106.             Case 0.5

    107.                 RetBuff8 = ConvertWave8MultiplySamplesBy2(RetBuff8, ToFormat.nChannels = 2)

    108.             Case 2

    109.                 RetBuff8 = ConvertWave8DivideSamplesBy2(RetBuff8, ToFormat.nChannels = 2)

    110.             Case 4

    111.                 RetBuff8 = ConvertWave8DivideSamplesBy2(RetBuff8, ToFormat.nChannels = 2)

    112.                 RetBuff8 = ConvertWave8DivideSamplesBy2(RetBuff8, ToFormat.nChannels = 2)

    113.             Case Else

    114.                 RetBuff8 = ConvertWave8ReSample(RetBuff8, FromFormat.lSamplesPerSec, ToFormat.lSamplesPerSec, ToFormat.nChannels = 2)

    115.             End Select

    116.         End If

    117.         

    118.         ConvertWave = RetBuff8

    119.     Else

    120.         ConvertWave = vbEmpty

    121.         Exit Function

    122.     End If

    123. End Function
    Last edited by CVMichael; Mar 19th, 2008 at 09:29 PM.
    Reply With Quote Reply With Quote
« Previous Thread | Next Thread »

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

Forum Rules


Click Here to Expand Forum to Full Width