delphi 做个录音机
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,shellapi;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Label1Click(Sender: TObject);
protected
procedure WndProc(var m: TMessage); override;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses MMSystem;
var
whIn1,whIn2, whOut: TWaveHdr;{wav文件是有一定结构的，其中包含储存音频数据的地方，即buf1,buf2,SaveBuf}
hWaveIn,hWaveOut: HWAVE;//输入或输出设备指针
fmt: TWaveFormatEx;
buf1,buf2,SaveBuf: Array of byte;//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;{指定格式类型; 默认 WAVE_FORMAT_PCM = 1;}
fmt.nChannels := 2;{指出波形数据的声道数; 单声道为 1, 立体声为 2}
fmt.nSamplesPerSec := 22050;{指定采样频率(每秒的样本数)}
fmt.nAvgBytesPerSec := 88200;{指定数据传输的传输速率(每秒的字节数)}
fmt.nBlockAlign := 4;{指定块对齐(每个样本的字节数), 块对齐是数据的最小单位}
fmt.wBitsPerSample := 16;{采样大小(字节), 每个样本的量化位数}
fmt.cbSize := 0;{附加信息的字节大小}
SaveBuf := nil; {清除已录制的内容}
{设备ID; 可以指定为: WAVE_MAPPER, 这样函数会根据给定的波形格式选择合适的设备}
即TWaveFormat 结构的指针; TWaveFormat 包含要申请的波形格式}
{Handle即回调函数地址或窗口句柄; 若不使用回调机制, 设为 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)); {左或右声道whIn1即TWaveHdr 结构的指针，做准备回写数据块工作}
waveInPrepareHeader(hWaveIn, @whIn2, SizeOf(TWaveHdr)); {左或右声道whIn2即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;
{wav文件是一段又一段的文件结构体TWaveHdr组成的}
procedure TForm1.Label1Click(Sender: TObject);
begin
ShellExecute(handle,'open','http://www.cnblogs.com/del/',nil,nil,SW_ShowNormal);
end;
end.
{综上我们可以看出，录音和放音都需要窗口句柄和设备句柄，原因在于它们本质都是应用程序和设备的交互，都需要知道彼此}
当然，这个不是最好的录音机，最好的是使用别人的控件，这样的控件简单的录音机不在话下，编写局域网聊天软件也是易如反掌。
没有评论:
发表评论