Solved

pitch control in wav files (vb3)

Posted on 1998-05-16
3
783 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
  • 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

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
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…

760 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

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now