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
Solved

pitch control in wav files (vb3)

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

Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
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…

808 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