程序師世界是廣大編程愛好者互助、分享、學習的平台，程序師世界有你更精彩！
設為首頁 加入收藏
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> 操作 Wave 文件(11): 使用 waveIn...函數錄制 wav 文件

操作 Wave 文件(11): 使用 waveIn...函數錄制 wav 文件

編輯：Delphi

　使用窗口接受音頻設備發出的消息:

unit　Unit1;　
　
interface　
　
uses　
　Windows,　Messages,　SysUtils,　Variants,　Classes,　Graphics,　Controls,　Forms,　
　Dialogs,　StdCtrls;　
　
type　
　TForm1　=　class(TForm)　
　　Button1:　TButton;　
　　Button2:　TButton;　
　　Button3:　TButton;　
　　procedure　FormCreate(Sender:　TObject);　
　　procedure　Button1Click(Sender:　TObject);　
　　procedure　Button2Click(Sender:　TObject);　
　　procedure　Button3Click(Sender:　TObject);　
　protected　
　　procedure　WndProc(var　m:　TMessage);　override;　
　end;　
　
var　
　Form1:　TForm1;　
　
implementation　
　
{$R　*.dfm}　　
　
uses　MMSystem;　
　
var　
　whIn1,whIn2,　whOut:　TWaveHdr;　
　hWaveIn,hWaveOut:　HWAVE;　
　fmt:　TWaveFormatEx;　
　buf1,buf2,SaveBuf:　TBytes;　
　
procedure　TForm1.FormCreate(Sender:　TObject);　
begin　
　Button1.Caption　:=　'開始錄音';　
　Button2.Caption　:=　'停止錄音';　
　Button3.Caption　:=　'播放錄音';　
end;　
　
//開始錄音　
procedure　TForm1.Button1Click(Sender:　TObject);　
begin　
　{指定要錄制的格式}　
　fmt.wFormatTag　:=　WAVE_FORMAT_PCM;　
　fmt.nChannels　:=　2;　
　fmt.nSamplesPerSec　:=　22050;　
　fmt.nAvgBytesPerSec　:=　88200;　
　fmt.nBlockAlign　:=　4;　
　fmt.wBitsPerSample　:=　16;　
　fmt.cbSize　:=　0;　
　
　SaveBuf　:=　nil;　{清除已錄制的內容}　
　
　if　waveInOpen(@hWaveIn,　WAVE_MAPPER,　@fmt,　Handle,　0,　CALLBACK_WINDOW)　=　0　then　
　begin　
　　SetLength(buf1,　1024*8);　
　　SetLength(buf2,　1024*8);　
　
　　whIn1.lpData　:=　PAnsiChar(buf1);　
　　whIn1.dwBufferLength　:=　Length(buf1);　
　　whIn1.dwBytesRecorded　:=　0;　
　　whIn1.dwUser　:=　0;　
　　whIn1.dwFlags　:=　0;　
　　whIn1.dwLoops　:=　0;　
　　whIn1.lpNext　:=　nil;　
　　whIn1.reserved　:=　0;　
　
　　whIn2.lpData　:=　PAnsiChar(buf2);　
　　whIn2.dwBufferLength　:=　Length(buf2);　
　　whIn2.dwBytesRecorded　:=　0;　
　　whIn2.dwUser　:=　0;　
　　whIn2.dwFlags　:=　0;　
　　whIn2.dwLoops　:=　0;　
　　whIn2.lpNext　:=　nil;　
　　whIn2.reserved　:=　0;　
　
　　waveInPrepareHeader(hWaveIn,　@whIn1,　SizeOf(TWaveHdr));　
　　waveInPrepareHeader(hWaveIn,　@whIn2,　SizeOf(TWaveHdr));　
　　waveInAddBuffer(hWaveIn,　@whIn1,　SizeOf(TWaveHdr));　
　　waveInAddBuffer(hWaveIn,　@whIn2,　SizeOf(TWaveHdr));　
　
　　waveInStart(hWaveIn);　
　end;　
end;　
　
//停止錄音　
procedure　TForm1.Button2Click(Sender:　TObject);　
begin　
　waveInStop(hWaveIn);　
　waveInUnprepareHeader(hWaveIn,　@whIn1,　SizeOf(TWaveHdr));　
　waveInUnprepareHeader(hWaveIn,　@whIn2,　SizeOf(TWaveHdr));　
　waveInClose(hWaveIn);　
end;　
　
//播放錄音　
procedure　TForm1.Button3Click(Sender:　TObject);　
begin　
　whOut.lpData　:=　PAnsiChar(SaveBuf);　
　whOut.dwBufferLength　:=　Length(SaveBuf);　
　whOut.dwBytesRecorded　:=　0;　
　whOut.dwUser　:=　0;　
　whOut.dwFlags　:=　0;　
　whOut.dwLoops　:=　1;　
　whOut.lpNext　:=　nil;　
　whOut.reserved　:=　0;　
　
　waveOutOpen(@hWaveOut,　WAVE_MAPPER,　@fmt,　Handle,　0,　CALLBACK_WINDOW);　
　waveOutPrepareHeader(hWaveOut,　@whOut,　SizeOf(TWaveHdr));　
　waveOutWrite(hWaveOut,　@whOut,　SizeOf(TWaveHdr));　
end;　
　
procedure　TForm1.WndProc(var　m:　TMessage);　
var　
　ordLen:　Integer;　
begin　
　inherited;　
　case　m.Msg　of　
　　{處理錄音消息}　
　　MM_WIM_OPEN:　;　　　{此消息只攜帶了設備句柄}　
　　MM_WIM_CLOSE:　;　　{此消息只攜帶了設備句柄}　
　　MM_WIM_DATA:　begin　{此消息攜帶了設備句柄和　WaveHdr　指針(LParam)}　
　　　{保存錄制的數據}　
　　　ordLen　:=　Length(SaveBuf);　
　　　SetLength(SaveBuf,　ordLen　+　PWaveHdr(m.LParam).dwBytesRecorded);　
　　　CopyMemory(Ptr(DWord(SaveBuf)+ordLen),　PWaveHdr(m.LParam).lpData,　PWaveHdr(m.LParam).dwBytesRecorded);　
　　　{繼續錄制}　
　　　waveInAddBuffer(hWaveIn,　PWaveHdr(m.LParam),　SizeOf(TWaveHdr));　
　　end;　
　
　　{處理播放消息}　
　　MM_WOM_OPEN:　;　　　{此消息只攜帶了設備句柄}　
　　MM_WOM_CLOSE:　;　　{此消息只攜帶了設備句柄}　
　　MM_WOM_DONE:　begin　{此消息攜帶了設備句柄和　WaveHdr　指針(LParam)}　
　　　waveOutUnprepareHeader(hWaveOut,　PWaveHdr(m.LParam),　SizeOf(TWaveHdr));　
　　　waveOutClose(hWaveOut);　
　　end;　
　end;　
end;　
　
end.　

　使用回調函數處理音頻設備發出的消息:

unit　Unit1;　
　
interface　
　
uses　
　Windows,　Messages,　SysUtils,　Variants,　Classes,　Graphics,　Controls,　Forms,　
　Dialogs,　StdCtrls;　
　
type　
　TForm1　=　class(TForm)　
　　Button1:　TButton;　
　　Button2:　TButton;　
　　Button3:　TButton;　
　　procedure　FormCreate(Sender:　TObject);　
　　procedure　Button1Click(Sender:　TObject);　
　　procedure　Button2Click(Sender:　TObject);　
　　procedure　Button3Click(Sender:　TObject);　
　end;　
　
var　
　Form1:　TForm1;　
　
implementation　
　
{$R　*.dfm}　
　
uses　MMSystem;　
　
var　
　whIn1,whIn2,　whOut:　TWaveHdr;　
　hWaveIn,hWaveOut:　HWAVE;　
　fmt:　TWaveFormatEx;　
　buf1,buf2,SaveBuf:　TBytes;　
　
//回調函數;　容易出錯的是:　系統回調函數中不能使用本地變量　
procedure　WaveProc(hWave:　HWAVE;　uMsg,　dwInstance,　dwParam1,　dwParam2:　DWord);　stdcall;　
var　
　ordLen:　Integer;　
begin　
　case　uMsg　of　
　　{處理錄音消息}　
　　MM_WIM_OPEN:　;　　　{此消息只攜帶了設備句柄}　
　　MM_WIM_CLOSE:　;　　{此消息只攜帶了設備句柄}　
　　MM_WIM_DATA:　begin　{此消息攜帶了設備句柄和　WaveHdr　指針(dwParam1)}　
　　　{保存錄制的數據}　
　　　ordLen　:=　Length(SaveBuf);　
　　　SetLength(SaveBuf,　ordLen　+　PWaveHdr(dwParam1).dwBytesRecorded);　
　　　CopyMemory(Ptr(DWord(SaveBuf)+ordLen),　PWaveHdr(dwParam1).lpData,　PWaveHdr(dwParam1).dwBytesRecorded);　
　　　{繼續錄制}　
　　　waveInAddBuffer(hWave,　PWaveHdr(dwParam1),　SizeOf(TWaveHdr));　
　　end;　
　
　　{處理播放消息}　
　　MM_WOM_OPEN:　;　　　{此消息只攜帶了設備句柄}　
　　MM_WOM_CLOSE:　;　　{此消息只攜帶了設備句柄}　
　　MM_WOM_DONE:　begin　{此消息攜帶了設備句柄和　WaveHdr　指針(dwParam1)}　
　　　waveOutUnprepareHeader(hWave,　PWaveHdr(dwParam1),　SizeOf(TWaveHdr));　
　　　waveOutClose(hWave);　
　　end;　
　end;　
end;　
　
procedure　TForm1.FormCreate(Sender:　TObject);　
begin　
　Button1.Caption　:=　'開始錄音';　
　Button2.Caption　:=　'停止錄音';　
　Button3.Caption　:=　'播放錄音';　
end;　
　
//開始錄音　
procedure　TForm1.Button1Click(Sender:　TObject);　
begin　
　{指定要錄制的格式}　
　fmt.wFormatTag　:=　WAVE_FORMAT_PCM;　
　fmt.nChannels　:=　2;　
　fmt.nSamplesPerSec　:=　22050;　
　fmt.nAvgBytesPerSec　:=　88200;　
　fmt.nBlockAlign　:=　4;　
　fmt.wBitsPerSample　:=　16;　
　fmt.cbSize　:=　0;　
　
　SaveBuf　:=　nil;　{清除已錄制的內容}　
　
　if　waveInOpen(@hWaveIn,　WAVE_MAPPER,　@fmt,　DWord(@WaveProc),　0,　CALLBACK_FUNCTION)　=　0　then　
　begin　
　　SetLength(buf1,　1024*8);　
　　SetLength(buf2,　1024*8);　
　
　　whIn1.lpData　:=　PAnsiChar(buf1);　
　　whIn1.dwBufferLength　:=　Length(buf1);　
　　whIn1.dwBytesRecorded　:=　0;　
　　whIn1.dwUser　:=　0;　
　　whIn1.dwFlags　:=　0;　
　　whIn1.dwLoops　:=　0;　
　　whIn1.lpNext　:=　nil;　
　　whIn1.reserved　:=　0;　
　
　　whIn2.lpData　:=　PAnsiChar(buf2);　
　　whIn2.dwBufferLength　:=　Length(buf2);　
　　whIn2.dwBytesRecorded　:=　0;　
　　whIn2.dwUser　:=　0;　
　　whIn2.dwFlags　:=　0;　
　　whIn2.dwLoops　:=　0;　
　　whIn2.lpNext　:=　nil;　
　　whIn2.reserved　:=　0;　
　
　　waveInPrepareHeader(hWaveIn,　@whIn1,　SizeOf(TWaveHdr));　
　　waveInPrepareHeader(hWaveIn,　@whIn2,　SizeOf(TWaveHdr));　
　　waveInAddBuffer(hWaveIn,　@whIn1,　SizeOf(TWaveHdr));　
　　waveInAddBuffer(hWaveIn,　@whIn2,　SizeOf(TWaveHdr));　
　
　　waveInStart(hWaveIn);　
　end;　
end;　
　
//停止錄音　
procedure　TForm1.Button2Click(Sender:　TObject);　
begin　
　waveInStop(hWaveIn);　
　waveInUnprepareHeader(hWaveIn,　@whIn1,　SizeOf(TWaveHdr));　
　waveInUnprepareHeader(hWaveIn,　@whIn2,　SizeOf(TWaveHdr));　
　waveInClose(hWaveIn);　
end;　
　
//播放錄音　
procedure　TForm1.Button3Click(Sender:　TObject);　
begin　
　whOut.lpData　:=　PAnsiChar(SaveBuf);　
　whOut.dwBufferLength　:=　Length(SaveBuf);　
　whOut.dwBytesRecorded　:=　0;　
　whOut.dwUser　:=　0;　
　whOut.dwFlags　:=　0;　
　whOut.dwLoops　:=　1;　
　whOut.lpNext　:=　nil;　
　whOut.reserved　:=　0;　
　
　waveOutOpen(@hWaveOut,　WAVE_MAPPER,　@fmt,　DWord(@WaveProc),　0,　CALLBACK_FUNCTION);　
　waveOutPrepareHeader(hWaveOut,　@whOut,　SizeOf(TWaveHdr));　
　waveOutWrite(hWaveOut,　@whOut,　SizeOf(TWaveHdr));　
end;　
　
end.　



  1. 上一頁:
  2. 下一頁:
Delphi
Delphi 2009 之 TLinkLabel

本例效果圖:　　代碼文件:unit Unit1;inter
Delphi 2007 IDE功能的動畫演示[6] - 快速查看Delphi所有的核心數據類型

談談使用delphi讀取獲取密碼緩存

　分　　類：安全　　語　　種：簡體中文　　編輯器：Delp
再學 GDI+[74]: 區域(3) - IsVisible

本例效果圖:　　代碼文件:unit Unit1;inter
Delphi與DirectX之DelphiX(68): TDIB.DoNovaEffect();

本例效果圖:代碼文件:unit Unit1;i
Delphi調用WinAPI: GetVolumeInformation - 讀取文件系統信息

//聲明:GetVolumeInformati
相關文章
閱讀排行榜
取Run下所有值(原創) Delphi與DirectX之DelphiX(63): TDIB.DoPosterize(); Delphi 控制Excel 如何在Delphi平台上實現圖像放大鏡 數據訪問部件的應用及編程（二） 詳測 Generics Collections TList (9): BinarySearch 再學 GDI+[3]: DrawRectangle - 繪制矩形 如此即可完成與服務端的通訊。 再學GDI+[103]: TGPImage(23) - 提取 GIF 動畫的每一幀(2) 使用靜態數組應該注意的問題 再學GDI+[15]: GDIPAPI 單元提供的Make及Color系列函數
熱門圖文
計算機程序的思維邏輯 (20)，思維邏輯 ivy中文參考文檔(21)-ant任務(9)-post resolve tasks 用ado在access存取二進制文件的一種辦法 C++ STL算法系列4---unique , unique_copy函數 《PHP編程最快明白》第五講：php目錄、文件操作 學習C++從哪入手？ yii用戶注冊表單驗證實例， Delphi 2009泛型容器單元(Generics.Collections)[1]: TList(2)
欄目導航
匯編語言DelphiGroovyWebSphereRationalPythonRuby編程解疑編程綜合問答更多關於編程編程問題解答
Copyright © 程式師世界 All Rights Reserved