Solved

pitch control in wav files (vb3)

Posted on 1998-05-16
3
818 Views
Last Modified: 2012-08-13
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.
0
Comment
Question by:mlm
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
3 Comments
 

Author Comment

by:mlm
ID: 1451706
Or how to modify the sample rate in play mode (real time)
0
 
LVL 5

Accepted Solution

by:
bin_huwairib earned 500 total points
ID: 1451707
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
 

Author Comment

by:mlm
ID: 1451708
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

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

717 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question