如何用vb 显示音频波形 ？谢谢求有关知识或代码谢谢

MP3播放器,并显示波形(API实现)新建"Form1"、"Form2"、"Module1"Form1:添加Command1(Caption="文件")、Command2(Caption="Start")、Command3(Caption="Stop"),Timer1,CommonDialog1,Text1'Form1代码Dim filename As String ' wave file to playDim errStr As String * 200 ' buffer for retrieving error messagesDim waveForm As Form2 ' form to draw wavegraph onConst MAX_SCROLL_VALUE = 1000 ' range for scroll controlsPrivate Sub Form_Load()' Initialize form, create wavegraph form Module1.fFileLoaded = False CommonDialog1.filename = "*.wav" CommonDialog1.DefaultExt = "wav" Set waveForm = New Form2 waveForm.Move Me.Left, Me.Top + Me.Height, Me.Width, Me.Height * 1.5 End SubPrivate Sub Command1_Click()'Open a wavefile and initialize the form CommonDialog1.ShowOpen filename = CommonDialog1.filename Text1.Text = filename LoadFile filename Module1.drawFrom = 0 Module1.drawTo = Module1.numSamples waveForm.DrawWavesEnd SubPrivate Sub Command2_Click()' Start playing the wavefile waveForm.Move Me.Left, Me.Top + Me.Height, Me.Width, Me.Height * 1.5 waveForm.Show 0, Me If (Module1.fPlaying = False) Then ' -1 specifies the wave mapper Play -1 End IfEnd SubPrivate Sub Command3_Click()' Stop playing the wavefile StopPlay Unload waveFormEnd SubPrivate Sub SetPlayRange()' Set the range to be played and redraw the wave graph Module1.drawFrom = CLng(Module1.numSamples * (HScroll1.Value / MAX_SCROLL_VALUE)) Module1.drawTo = CLng(Module1.numSamples * (HScroll2.Value / MAX_SCROLL_VALUE)) waveForm.DrawWavesEnd SubPrivate Sub Timer1_Timer() If Module1.fPlaying = False Then Module1.CloseWaveOut Timer1.Enabled = False End IfEnd Sub

'Module1代码Option ExplicitPublic Const CALLBACK_FUNCTION = &H30000Public Const MMIO_READ = &H0Public Const MMIO_FINDCHUNK = &H10Public Const MMIO_FINDRIFF = &H20Public Const MM_WOM_DONE = &H3BDType 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 LongEnd TypeType WAVEHDR lpData As Long dwBufferLength As Long dwBytesRecorded As Long dwUser As Long dwFlags As Long dwLoops As Long lpNext As Long Reserved As Long End Type Type WAVEINCAPS wMid As Integer wPid As Integer vDriverVersion As Long szPname As String * 32 dwFormats As Long wChannels As Integer End Type Type WAVEFORMAT wFormatTag As Integer nChannels As Integer nSamplesPerSec As Long nAvgBytesPerSec As Long nBlockAlign As Integer wBitsPerSample As Integer cbSize As IntegerEnd TypeType MMCKINFO ckid As Long ckSize As Long fccType As Long dwDataOffset As Long dwFlags As LongEnd Type

Dim rc As LongDim msg As String * 200' variables for managing wave filePublic format As WAVEFORMATDim hmmioOut As LongDim mmckinfoParentIn As MMCKINFODim mmckinfoSubchunkIn As MMCKINFODim hWaveOut As LongDim bufferIn As LongDim hmem As LongDim outHdr As WAVEHDRPublic numSamples As LongPublic drawFrom As LongPublic drawTo As LongPublic fFileLoaded As BooleanPublic fPlaying As BooleanSub waveOutProc(ByVal hwi As Long, ByVal uMsg As Long, ByVal dwInstance As Long, ByRef hdr As WAVEHDR, ByVal dwParam2 As Long)' Wave IO Callback function If (uMsg = MM_WOM_DONE) Then fPlaying = False End IfEnd SubSub CloseWaveOut()' Close the waveout device rc = waveOutReset(hWaveOut) rc = waveOutUnprepareHeader(hWaveOut, outHdr, Len(outHdr)) rc = waveOutClose(hWaveOut)End Sub

Public 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 LongPublic Declare Function waveOutPrepareHeader Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As LongPublic Declare Function waveOutReset Lib "winmm.dll" (ByVal hWaveIn As Long) As LongPublic Declare Function waveOutStart Lib "winmm.dll" (ByVal hWaveIn As Long) As LongPublic Declare Function waveOutStop Lib "winmm.dll" (ByVal hWaveIn As Long) As LongPublic Declare Function waveOutUnprepareHeader Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As LongPublic Declare Function waveOutClose Lib "winmm.dll" (ByVal hWaveIn As Long) As LongPublic Declare Function waveOutGetDevCaps Lib "winmm.dll" Alias "waveInGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As WAVEINCAPS, ByVal uSize As Long) As Long

Public Declare Function waveOutGetNumDevs Lib "winmm.dll" () As LongPublic Declare Function waveOutGetErrorText Lib "winmm.dll" Alias "waveInGetErrorTextA" (ByVal err As Long, ByVal lpText As String, ByVal uSize As Long) As LongPublic Declare Function waveOutAddBuffer Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As LongPublic Declare Function waveOutWrite Lib "winmm.dll" (ByVal hWaveOut As Long, lpWaveOutHdr As WAVEHDR, ByVal uSize As Long) As LongPublic Declare Function mmioClose Lib "winmm.dll" (ByVal hmmio As Long, ByVal uFlags As Long) As LongPublic Declare Function mmioDescend Lib "winmm.dll" (ByVal hmmio As Long, lpck As MMCKINFO, lpckParent As MMCKINFO, ByVal uFlags As Long) As LongPublic Declare Function mmioDescendParent Lib "winmm.dll" Alias "mmioDescend" (ByVal hmmio As Long, lpck As MMCKINFO, ByVal x As Long, ByVal uFlags As Long) As LongPublic Declare Function mmioOpen Lib "winmm.dll" Alias "mmioOpenA" (ByVal szFileName As String, lpmmioinfo As mmioinfo, ByVal dwOpenFlags As Long) As LongPublic Declare Function mmioRead Lib "winmm.dll" (ByVal hmmio As Long, ByVal pch As Long, ByVal cch As Long) As LongPublic Declare Function mmioReadFormat Lib "winmm.dll" Alias "mmioRead" (ByVal hmmio As Long, ByRef pch As WAVEFORMAT, ByVal cch As Long) As LongPublic Declare Function mmioStringToFOURCC Lib "winmm.dll" Alias "mmioStringToFOURCCA" (ByVal sz As String, ByVal uFlags As Long) As LongPublic Declare Function mmioAscend Lib "winmm.dll" (ByVal hmmio As Long, lpck As MMCKINFO, ByVal uFlags As Long) As LongPublic Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As LongPublic Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Long) As LongPublic Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Long) As LongPublic Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (struct As Any, ByVal ptr As Long, ByVal cb As Long)

Sub waveOutProc(ByVal hwi As Long, ByVal uMsg As Long, ByVal dwInstance As Long, ByRef hdr As WAVEHDR, ByVal dwParam2 As Long)' Wave IO Callback function If (uMsg = MM_WOM_DONE) Then fPlaying = False End IfEnd SubSub CloseWaveOut()' Close the waveout device rc = waveOutReset(hWaveOut) rc = waveOutUnprepareHeader(hWaveOut, outHdr, Len(outHdr)) rc = waveOutClose(hWaveOut)End Sub

Sub LoadFile(inFile As String)' Load wavefile into memory Dim hmmioIn As Long Dim mmioinf As mmioinfo fFileLoaded = False If (inFile = "") Then GlobalFree (hmem) Exit Sub End If ' Open the input file hmmioIn = mmioOpen(inFile, mmioinf, MMIO_READ) 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) ' Find the data subchunk mmckinfoSubchunkIn.ckid = mmioStringToFOURCC("data", 0) rc = mmioDescend(hmmioIn, mmckinfoSubchunkIn, mmckinfoParentIn, MMIO_FINDCHUNK) If (rc <> 0) Then rc = mmioClose(hmmioOut, 0) MsgBox "Couldn't get data chunk" Exit Sub End If ' Allocate soundbuffer and read sound data GlobalFree hmem hmem = GlobalAlloc(&H40, mmckinfoSubchunkIn.ckSize) bufferIn = GlobalLock(hmem) rc = mmioRead(hmmioIn, bufferIn, mmckinfoSubchunkIn.ckSize) numSamples = mmckinfoSubchunkIn.ckSize / format.nBlockAlign ' Close file rc = mmioClose(hmmioOut, 0) fFileLoaded = TrueEnd Sub

Sub Play(ByVal soundcard As Integer)' Send audio buffer to wave output rc = waveOutOpen(hWaveOut, soundcard, format, AddressOf waveOutProc, 0, CALLBACK_FUNCTION) If (rc <> 0) Then GlobalFree (hmem) waveOutGetErrorText rc, msg, Len(msg) MsgBox msg Exit Sub End If outHdr.lpData = bufferIn + (drawFrom * format.nBlockAlign) outHdr.dwBufferLength = (drawTo - drawFrom) * format.nBlockAlign outHdr.dwFlags = 0 outHdr.dwLoops = 0 rc = waveOutPrepareHeader(hWaveOut, outHdr, Len(outHdr)) If (rc <> 0) Then waveOutGetErrorText rc, msg, Len(msg) MsgBox msg End If rc = waveOutWrite(hWaveOut, outHdr, Len(outHdr)) If (rc <> 0) Then GlobalFree (hmem) Else fPlaying = True Form1.Timer1.Enabled = True End IfEnd SubSub StopPlay() waveOutReset (hWaveOut)End SubSub GetStereo16Sample(ByVal sample As Long, ByRef leftVol As Double, ByRef rightVol As Double)' These subs obtain a PCM sample and converts it into volume levels from (-1 to 1) Dim sample16 As Integer Dim ptr As Long ptr = sample * format.nBlockAlign + bufferIn CopyStructFromPtr sample16, ptr, 2 leftVol = sample16 / 32768 CopyStructFromPtr sample16, ptr + 2, 2 rightVol = sample16 / 32768End SubSub GetStereo8Sample(ByVal sample As Long, ByRef leftVol As Double, ByRef rightVol As Double) Dim sample8 As Byte Dim ptr As Long ptr = sample * format.nBlockAlign + bufferIn CopyStructFromPtr sample8, ptr, 1 leftVol = (sample8 - 128) / 128 CopyStructFromPtr sample8, ptr + 1, 1 rightVol = (sample8 - 128) / 128End SubSub GetMono16Sample(ByVal sample As Long, ByRef leftVol As Double) Dim sample16 As Integer Dim ptr As Long ptr = sample * format.nBlockAlign + bufferIn CopyStructFromPtr sample16, ptr, 2 leftVol = sample16 / 32768End SubSub GetMono8Sample(ByVal sample As Long, ByRef leftVol As Double) Dim sample8 As Byte Dim ptr As Long ptr = sample * format.nBlockAlign + bufferIn CopyStructFromPtr sample8, ptr, 1 leftVol = (sample8 - 128) / 128End Sub

'Form2代码Option ExplicitPublic Sub DrawWaves()' Graph the waveform Dim x As Long ' current X position Dim leftYOffset As Long ' Y offset for left channel graph Dim rightYOffset As Long ' Y offset for right channel graph Dim curLeftY As Long ' current left channel Y value Dim curRightY As Long ' current right channel Y value Dim lastX As Long ' last X position Dim lastLeftY As Long ' last left channel Y value Dim lastRightY As Long ' last right channel Y value Dim maxAmplitude As Long ' the maximum amplitude for a wavegraph on the form Dim leftVol As Double ' buffer for retrieving the left volume level Dim rightVol As Double ' buffer for retrieving the right volume level Dim scaleFactor As Double ' samples per pixel on the wave graph Dim xStep As Double ' pixels per sample on the wave graph Dim curSample As Long ' current sample number ' clear the screen Me.Cls ' if no file is loaded, don't try to draw graph If (Module1.fFileLoaded = False) Then Exit Sub End If ' calculate drawing parameters scaleFactor = (Module1.drawTo - Module1.drawFrom) / Me.Width If (scaleFactor < 1) Then xStep = 1 / scaleFactor Else xStep = 1 End If ' Draw the graph If (Module1.format.nChannels = 2) Then maxAmplitude = Me.Height / 4 leftYOffset = maxAmplitude rightYOffset = maxAmplitude * 3 For x = 0 To Me.Width Step xStep curSample = scaleFactor * x + Module1.drawFrom If (Module1.format.wBitsPerSample = 16) Then GetStereo16Sample curSample, leftVol, rightVol Else GetStereo8Sample curSample, leftVol, rightVol End If curRightY = CLng(rightVol * maxAmplitude) curLeftY = CLng(leftVol * maxAmplitude) Line (lastX, leftYOffset + lastLeftY)-(x, curLeftY + leftYOffset) Line (lastX, rightYOffset + lastRightY)-(x, curRightY + rightYOffset) lastLeftY = curLeftY lastRightY = curRightY lastX = x Next Else maxAmplitude = Me.Height / 2 leftYOffset = maxAmplitude For x = 0 To Me.Width Step xStep curSample = scaleFactor * x + Module1.drawFrom If (Module1.format.wBitsPerSample = 16) Then GetMono16Sample curSample, leftVol Else GetMono8Sample curSample, leftVol End If curLeftY = CLng(leftVol * maxAmplitude) Line (lastX, leftYOffset + lastLeftY)-(x, curLeftY + leftYOffset) lastLeftY = curLeftY lastX = x Next End IfEnd SubPrivate Sub Form_Paint() DrawWavesEnd SubPrivate Sub Form_Resize() DrawWavesEnd Sub

太厉害啦

能不能把最关键的（就是波形读取显示）部分简要解释一下呢？

主要的绘制工作在Form2的代码里, Form1处理播放与停止工作

其实用到的API都是winmm.dll(Windows Media Player的运行库)中的,标准模块中WaveOutProc是绘制模块,LoadFile加载音频.具体的API用法可以参看Microsoft技术库

谢谢！~真的好强`我在其他地方找了好久的资料都找不到~~~谢谢了

谢谢Ultraman_King 的帮助

是wav播放器，不是MP3播放器。

马克
这坟挖的太好了~

我补充一下吧，不用API解决,平台是EXCEL中的 VBA。
在模块中定义如下代码：
先定义一个 Wav文件的头，WAV是二进制文件。这个头信息相关资料请查看相关说明，我到后面给出参考资料。
Type WaveHead
ckid As Long
ckSize As Long
strflag1 As Long
ID As Long
Size As Long
AudioFormat As Integer
NumChannels As Integer
SampleRate As Long
ByteRate As Long
BlockAlign As Integer
BitsPerSample As Integer
DataID As Long
DataSize As Long
End Type
Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) '此函数就把内存中的数据转移到另一个区域中
Public Whead as WaveHead
Public ayyBuf() As Byte ‘读入的文件缓存区
Public numSamples As Long ‘波形数据长度，在WaveHead 的ckSize成员变量中。计算方法numSamples =(ckSize-44)/2
‘加载WAV文件
‘inFile 加载的文件路径 C:\1.WAV
'sheetname 波形数据输出的表格
‘filen 输出到表的列编号
Sub LoadFile(inFile As String, sheetname As String, filen As Long)
Open inFile For Binary As #1
ReDim ayyBuf(LOF(1) - 1)
Get #1, , ayyBuf
Close #1
CopyMemory ByVal VarPtr(Whead), ByVal VarPtr(ayyBuf(0)), 44
numSamples=(Whead.ckSize-44)/2
For i = 0 To numSamples - 1
ThisWorkbook.Worksheets(sheetname).Cells(i + 1, filen + 1) = leftVol(i)
Next
end sub
‘单声道16位的PCM区域数据转换成时域波形数据
‘sample 0-N
‘leftVol 转换值
Sub GetMono16Sample(ByVal sample As Long, ByRef leftVol As Double)
Dim sample16 As Integer
CopyMemory ByVal VarPtr(sample16), ByVal VarPtr(ayyBuf(sample * format.nBlockAlign + 44)), 2
leftVol = sample16 / 32768
End Sub
'恢复信号到数据，等会保存用
Function RepMono16Sample(leftVol As Double) As Long
Dim sample16 As Long
sample16 = Int(leftVol * 32768)
If sample16 >= 32767 Then
RepMono16Sample = 32767
Else
If sample16 <= -32768 Then
RepMono16Sample = -32768
Else
RepMono16Sample = sample16
End If
End If
End Function