pitch control in wav files (vb3)

I need to use this function:
Declare Function waveOutGetPitch Lib "MMSYSTEM" (ByVal hWaveOut As Integer, lpdwpitch As Long) As Integer
Declare Function waveOutSetPitch Lib "MMSYSTEM" (ByVal hWaveOut As Integer, ByVal dwPitch As Long) As Integer
To get and modify "pitch" control in a .wav files.
I need a sample.
mlmAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

mlmAuthor Commented:
Or how to modify the sample rate in play mode (real time)
0
bin_huwairibCommented:
mlm,

Here you go the code you are looking for.

1- Add form1.
2- Add command1, command2, command3 and command4.
3- Paste this code:

Private Const CALLBACK_WINDOW = &H10000
Private Const MMIO_FINDCHUNK = &H10
Private Const MMIO_FINDRIFF = &H20

Private Const MMSYSERR_NOERROR = 0
Private Const MMSYSERR_INVALHANDLE = 5
Private Const MMSYSERR_NODRIVER = 6
Private Const MMSYSERR_NOMEM = 7
Private Const MMSYSERR_NOTSUPPORTED = 8

Private Type WAVEFORMAT
 wFormatTag As Integer
 nChannels As Integer
 nSamplesPerSec As Long
 nAvgBytesPerSec As Long
 nBlockAlign As Integer
 wBitsPerSample As Integer
 cbSize As Integer
End Type

Private Type mmioinfo
 dwFlags As Long
 fccIOProc As Long
 pIOProc As Long
 wErrorRet As Long
 htask As Long
 cchBuffer As Long
 pchBuffer As String
 pchNext As String
 pchEndRead As String
 pchEndWrite As String
 lBufOffset As Long
 lDiskOffset As Long
 adwInfo(4) As Long
 dwReserved1 As Long
 dwReserved2 As Long
 hmmio As Long
End Type

Private Type MMCKINFO
 ckid As Long
 ckSize As Long
 fccType As Long
 dwDataOffset As Long
 dwFlags As Long
End Type


Private Declare Function waveOutOpen Lib "winmm.dll" (lphWaveIn As Long, ByVal uDeviceID As Long, lpFormat As WAVEFORMAT, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
Private Declare Function mmioOpen Lib "winmm.dll" Alias "mmioOpenA" (ByVal szFileName As String, lpmmioinfo As mmioinfo, ByVal dwOpenFlags As Long) As Long
Private Declare Function mmioClose Lib "winmm.dll" (ByVal hmmio As Long, ByVal uFlags As Long) As Long
Private Declare Function mmioStringToFOURCC Lib "winmm.dll" Alias "mmioStringToFOURCCA" (ByVal sz As String, ByVal uFlags As Long) As Long
Private Declare Function mmioDescend Lib "winmm.dll" (ByVal hmmio As Long, lpck As MMCKINFO, lpckParent As MMCKINFO, ByVal uFlags As Long) As Long
Private Declare Function mmioReadFormat Lib "winmm.dll" Alias "mmioRead" (ByVal hmmio As Long, ByRef pch As WAVEFORMAT, ByVal cch As Long) As Long
Private Declare Function mmioAscend Lib "winmm.dll" (ByVal hmmio As Long, lpck As MMCKINFO, ByVal uFlags As Long) As Long
Private Declare Function mmioDescendParent Lib "winmm.dll" Alias "mmioDescend" (ByVal hmmio As Long, lpck As MMCKINFO, ByVal x As Long, ByVal uFlags As Long) As Long
Private Declare Function waveOutClose Lib "winmm.dll" (ByVal hWaveOut As Long) As Long

Private Declare Function waveOutGetPitch Lib "winmm.dll" (ByVal hWaveOut As Long, lpdwPitch As Long) As Long
Private Declare Function waveOutGetPlaybackRate Lib "winmm.dll" (ByVal hWaveOut As Long, lpdwRate As Long) As Long
Private Declare Function waveOutSetPitch Lib "winmm.dll" (ByVal hWaveOut As Long, ByVal dwPitch As Long) As Long
Private Declare Function waveOutSetPlaybackRate Lib "winmm.dll" (ByVal hWaveOut As Long, ByVal dwRate As Long) As Long

Dim rc As Long
Dim hWaveOut As Long
Dim hmmioOut As Long

Dim Format As WAVEFORMAT
Dim mmckinfoSubchunkIn As MMCKINFO
Dim mmckinfoParentIn As MMCKINFO

Private Sub Command1_Click()
 MsgBox WaveOutPitch(True, 0) 'Get Pitch
End Sub

Private Sub Command2_Click()
 Call WaveOutPitch(False, 10) 'Set Pitch
End Sub

Private Sub Command3_Click()
 MsgBox WaveOutPBRate(True, 0) 'Get Pitch
End Sub

Private Sub Command4_Click()
 Call WaveOutPBRate(False, 10) 'Set Pitch
End Sub

Function WaveOutPitch(GetPitch As Boolean, PitchValue As Long) As Long
 WaveOutPitch = 0
 If GetPitch Then
  Dim MyPitch As Long
 
  rc = waveOutGetPitch(hWaveOut, MyPitch)
  Select Case rc
   Case MMSYSERR_NOERROR
    WaveOutPitch = MyPitch
   Case MMSYSERR_INVALHANDLE
    MsgBox "Invalid Handle"
   Case MMSYSERR_NODRIVER
    MsgBox "No Driver"
   Case MMSYSERR_NOMEM
    MsgBox "No Memory"
   Case MMSYSERR_NOTSUPPORTED
    MsgBox "Not Supported"
  End Select
 
 Else
  rc = waveOutSetPitch(hWaveOut, PitchValue)
  If rc <> MMSYSERR_NOERROR Then
   MsgBox "Couldn't Set"
  End If
 End If
End Function

Function WaveOutPBRate(GetPBack As Boolean, PBValue As Long) As Long
 WaveOutPBRate = 0
 If GetPBack Then
  Dim MyPBack As Long
 
  rc = waveOutGetPlaybackRate(hWaveOut, MyPBack)
  Select Case rc
   Case MMSYSERR_NOERROR
    WaveOutPBRate = MyPBack
   Case MMSYSERR_INVALHANDLE
    MsgBox "Invalid Handle"
   Case MMSYSERR_NODRIVER
    MsgBox "No Driver"
   Case MMSYSERR_NOMEM
    MsgBox "No Memory"
   Case MMSYSERR_NOTSUPPORTED
    MsgBox "Not Supported"
  End Select
 
 Else
  rc = waveOutSetPlaybackRate(hWaveOut, PBValue)
  If rc <> MMSYSERR_NOERROR Then
   MsgBox "Couldn't Set"
  End If
 End If
End Function

Sub LoadFile(inFile As String)
 Dim hmmioIn As Long
 Dim mmioinf As mmioinfo
   
 'Open the input file
 hmmioIn = mmioOpen(inFile, mmioinf, 0)
 If hmmioIn = 0 Then
  MsgBox "Error opening input file, rc = " & mmioinf.wErrorRet
  Exit Sub
 End If
   
 'Check if this is a wave file
 mmckinfoParentIn.fccType = mmioStringToFOURCC("WAVE", 0)
 rc = mmioDescendParent(hmmioIn, mmckinfoParentIn, 0, MMIO_FINDRIFF)
 If (rc <> 0) Then
  rc = mmioClose(hmmioOut, 0)
  MsgBox "Not a wave file"
  Exit Sub
 End If

 ' Get format info
 mmckinfoSubchunkIn.ckid = mmioStringToFOURCC("fmt", 0)
 rc = mmioDescend(hmmioIn, mmckinfoSubchunkIn, mmckinfoParentIn, MMIO_FINDCHUNK)
 If (rc <> 0) Then
  rc = mmioClose(hmmioOut, 0)
  MsgBox "Couldn't get format chunk"
  Exit Sub
 End If
 rc = mmioReadFormat(hmmioIn, Format, Len(Format))
 If (rc = -1) Then
  rc = mmioClose(hmmioOut, 0)
  MsgBox "Error reading format"
  Exit Sub
 End If
 rc = mmioAscend(hmmioIn, mmckinfoSubchunkIn, 0)
   
 'Close file
 rc = mmioClose(hmmioOut, 0)
End Sub

Private Sub Form_Load()
 LoadFile "d:\winnt\media\chimes.wav"
 Call waveOutOpen(hWaveOut, -1, Format, hWnd, 0, CALLBACK_WINDOW)
 
 Command1.Caption = "Get Pitch"
 Command2.Caption = "Set Pitch"
 Command3.Caption = "Get PlayBack Rate"
 Command4.Caption = "Set PlayBack Rate"
End Sub

Private Sub Form_Unload(Cancel As Integer)
 If hWaveOut <> 0 Then Call waveOutClose(hWaveOut)
End Sub


Best regards
Bin Huwairib
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
mlmAuthor Commented:
This doesn't work whit vb3; "winmm.dll" it's for vb4/5. So I try to "convert"  to vb3.
Thank's a lot.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.