|
#2
谈一刻2012-08-03 17:18
抄了某老师的程序学习，建了窗口，2个命令按钮，运行程序，出现错误，频率参数如何读取、？请教诸
位如何能让这段程序运行出效果。 picWidth = picFrequency.ScaleWidth 该行错误提示“无效限定符”，不知道如何解决。 Option Explicit Private Const WHDR_DONE = &H1 Private Const GMEM_ZEROINIT = &H40 Private Const DEVICEID = -1 Private Type WAVEHDR lpData As Long ' 指向波形数据缓存的指针，即波形数据缓存的地址 dwBufferLength As Long ' 缓存的长度，缓存的字节数 dwBytesRecorded As Long ' 记录波形数据缓存中有多少字节的数据 dwUser As Long ' User data. dwFlags As Long ' Flags supplying information about the buffer. Set equal to zero. dwLoops As Long ' Number of times to play the loop. Set equal to zero. lpNext As Long ' Not used reserved As Long ' Not used End Type 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 Declare Function waveInGetNumDevs Lib "winmm" () As Long Private Declare Function waveInGetDevCaps Lib "winmm" Alias "waveInGetDevCapsA" (ByVal uDeviceID As Long, ByVal WaveInCapsPointer As Long, ByVal WaveInCapsStructSize As Long) As Long Private Declare Function waveInGetErrorText Lib "winmm.dll" Alias "waveInGetErrorTextA" (ByVal err As Long, ByVal lpText As String, ByVal uSize As Long) As Long Private Declare Function waveInOpen 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 waveInPrepareHeader Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long Private Declare Function waveInReset Lib "winmm.dll" (ByVal hWaveIn As Long) As Long Private Declare Function waveInStart Lib "winmm.dll" (ByVal hWaveIn As Long) As Long Private Declare Function waveInStop Lib "winmm.dll" (ByVal hWaveIn As Long) As Long Private Declare Function waveInUnprepareHeader Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long Private Declare Function waveInClose Lib "winmm.dll" (ByVal hWaveIn As Long) As Long Private Declare Function waveInAddBuffer Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long Private Declare Function waveInAddBuff Lib "winmm.dll" Alias "waveInAddBuffer" (ByVal InputDeviceHandle As Long, ByVal WaveHdrPointer As Long, ByVal WaveHdrStructSize As Long) As Long Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long Private Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Long) As Long Private Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Long) As Long Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hmem As Long) As Long Private Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long Private Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Sub CopyStringFromStruct Lib "kernel32" Alias "RtlMoveMemory" (ByVal a As String, P As Any, ByVal cb As Long) Private Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (struct As Any, ByVal ptr As Long, ByVal cb As Long) Private Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" (ByVal ptr As Long, struct As Any, ByVal cb As Long) Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByRef lParam As WAVEHDR) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private m_sErrMsg As String * 256 '// 保存错误消息 Private m_hWaveIn As Long '// 波形输出设备句柄 Private m_wFormat As WAVEFORMAT '// Private m_inHdr As WAVEHDR '// Private m_hMem As Long '// 指向分配的内存块的指针 Private m_lBuffersize As Long '// 存放波形数据的缓存大小 Private m_InData() As Byte '// 波形数据 Private m_lngRetVal As Long Private m_CellSpace As Long Private m_CellWidth As Long Private m_BarCounts As Long Private m_ForeColor As Long Private m_BackColor As Long '// '// 接收来自波形输入设备的数据 '// Private Sub StartInput() ' 设置波形头格式 m_wFormat.wFormatTag = 1 m_wFormat.nChannels = 1 '2 m_wFormat.wBitsPerSample = 16 m_wFormat.nSamplesPerSec = 44100 m_wFormat.nBlockAlign = m_wFormat.nChannels * m_wFormat.wBitsPerSample / 8 m_wFormat.nAvgBytesPerSec = m_wFormat.nSamplesPerSec * m_wFormat.nBlockAlign m_wFormat.cbSize = Len(m_wFormat) ' 设置波形数据缓存大小 m_lBuffersize = (m_wFormat.nSamplesPerSec * m_wFormat.nBlockAlign * m_wFormat.nChannels * 0.1) - _ ((m_wFormat.nSamplesPerSec * m_wFormat.nBlockAlign * m_wFormat.nChannels * 0.1) Mod _ (m_wFormat.nBlockAlign)) ' 从堆上分配m_lBuffersize大小的内存,用来保存录入的波形数据 m_hMem = GlobalAlloc(GMEM_ZEROINIT, m_lBuffersize) ' 填充波形数据结构 m_inHdr.lpData = GlobalLock(m_hMem) m_inHdr.dwBufferLength = m_lBuffersize m_inHdr.dwFlags = 0 m_inHdr.dwLoops = 0 ' 现在打开波形输入设备 m_lngRetVal = waveInOpen(m_hWaveIn, DEVICEID, m_wFormat, 0, 0, 0) If m_lngRetVal <> 0 Then waveInGetErrorText m_lngRetVal, m_sErrMsg, Len(m_sErrMsg) MsgBox m_sErrMsg Exit Sub End If ' 生成信息头 m_lngRetVal = waveInPrepareHeader(m_hWaveIn, m_inHdr, Len(m_inHdr)) If (m_lngRetVal <> 0) Then waveInGetErrorText m_lngRetVal, m_sErrMsg, Len(m_sErrMsg) MsgBox m_sErrMsg Exit Sub End If ' 开始记录波形数据 m_lngRetVal = waveInAddBuffer(m_hWaveIn, m_inHdr, Len(m_inHdr)) m_lngRetVal = waveInStart(m_hWaveIn) tmrRecord.Enabled = True End Sub '// '// 停止接收来自波形输入设备的波形数据 '// Private Sub StopInput() tmrRecord.Enabled = False m_lngRetVal = waveInReset(m_hWaveIn) m_lngRetVal = waveInStop(m_hWaveIn) waveInUnprepareHeader m_hWaveIn, m_inHdr, Len(m_inHdr) GlobalFree m_hMem m_lngRetVal = waveInClose(m_hWaveIn) End Sub '// '// 获得波形数据 '// Private Sub CaptureWaveOutput() Dim lngPtr As Long ' 波形数据缓存中已经填满波形数据 If m_inHdr.dwFlags And WHDR_DONE Then m_lngRetVal = waveInAddBuffer(m_hWaveIn, m_inHdr, Len(m_inHdr)) If m_lngRetVal <> 0 Then ' 波形数据记录失败" Exit Sub End If ' 获得左右声道的波形采样数据 lngPtr = m_inHdr.lpData ReDim Preserve m_InData(m_inHdr.dwBytesRecorded) CopyStructFromPtr m_InData(0), lngPtr, m_inHdr.dwBytesRecorded ' 画左右声道波形 DrawWaveform End If End Sub '// '// 画左右声道波形 '// Private Sub DrawWaveform() On Error Resume Next Dim lOffset As Long Dim lUsage As Long Dim lIndex As Long Dim lPos As Long Dim picWidth As Long Dim picHeight As Long Dim perHeight As Long picWidth = picFrequency.ScaleWidth picHeight = picFrequency.ScaleHeight perHeight = ((picHeight - (m_CellSpace + 1)) / 3) lOffset = m_CellSpace For lIndex = 0 To m_BarCounts lUsage = (m_InData(lIndex) / 255) * picHeight For lPos = 0 To perHeight picFrequency.Line (lOffset, lPos * 3)-(lOffset + m_CellWidth, lPos * 3 + 1), _ IIf(lUsage >= 255 * (1 - lPos / perHeight), m_ForeColor, m_BackColor), BF Next lOffset = lOffset + m_CellWidth + m_CellSpace Next picFrequency.Refresh End Sub Private Sub Form_Load() m_CellSpace = 2 m_CellWidth = 8 m_BarCounts = 32 m_ForeColor = &HC000& m_BackColor = &H6000& Me.AutoRedraw = True Me.ScaleMode = vbPixels picFrequency.AutoRedraw = True picFrequency.ScaleMode = vbPixels picFrequency.DrawWidth = 1 tmrRecord.Interval = 100 End Sub Private Sub Command1_Click() StartInput End Sub Private Sub Command2_Click() StopInput End Sub Private Sub Form_Unload(Cancel As Integer) StopInput End Sub Private Sub tmrRecord_Timer() CaptureWaveOutput End Sub |
本人略懂点vb,flash,无奈编程水平不行，有一创意未能付诸实现：程序读取播放中的音频文件，分析频
谱，设定如
频率是100Hz的强度对应为“音乐伴舞”的左腿，
频率是300Hz的强度对应为“音乐伴舞”的右腿，
频率是600Hz的强度对应为“音乐伴舞”的左臂，
频率是900Hz的强度对应为“音乐伴舞”的右臂，
频率是3000Hz的强度对应为“音乐伴舞”的左眼，
频率是5000Hz的强度对应为“音乐伴舞”的右眼，
频率是7000Hz的强度对应为“音乐伴舞”的脖子。
这样，这个跳舞的机器人就随着不同的频谱，不同的强度，作出不同的动作
了。对应的部位可以定时或者手动改变。不知大家有无趣弄弄，编好了记得要写上“创意来自谭建伟”哦。
谢谢。
20120721