unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, MPlayer;
type
TWavHeader = record //定义一个Wav文件头格式
rId : longint;
rLen : longint;
wId : longint;
fId : longint;
fLen : longint;
wFormatTag : word;
nChannels : word;
nSamplesPerSec : longint;
nAvgBytesPerSec : longint;
nBlockAlign : word;
wBitsPerSample : word;
dId : longint;
wSampleLength : longint;
end;
TForm1 = class(TForm)
MediaPlayer1: TMediaPlayer;
BtStart: TButton;
BtStop: TButton;
procedure CreateWav(channels : word;
resolution : word;
rate : longint;
fn : string);//自定义写一个Wav文件头过程
procedure BtStartClick(Sender: TObject);
procedure BtStopClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.CreateWav( channels : word;
{ 1(单声)或者2(立体声) }
resolution : word;
{ 8或者16,代表8位或16位声音 }
rate : longint;
{ 声音频率,如11025,22050, 44100}
fn : string { 对应的文件名称 } );
var
wf : file of TWavHeader;
wh : TWavHeader;
begin
wh.rId := $46464952;
wh.rLen := 36;
wh.wId := $45564157;
wh.fId := $20746d66;
wh.fLen := 16;
wh.wFormatTag := 1;
wh.nChannels := channels;
wh.nSamplesPerSec := rate;
wh.nAvgBytesPerSec := channels*rate*(resolution div 8);
wh.nBlockAlign := channels*(resolution div 8);
wh.wBitsPerSample := resolution;
wh.dId := $61746164;
wh.wSampleLength := 0;
assignfile(wf,fn);
{打开对应文件 }
rewrite(wf);
{移动指针到文件头}
write(wf,wh);
{写进文件头 }
closefile(wf);
{关闭文件 }
end;
procedure TForm1.BtStartClick(Sender: TObject);
begin
try
//在程序当前目录下创建一个Wav文件Temp.wav
CreateWav(1, 8, 11025, (ExtractFilePath(Application.ExeName)+ 'Temp.wav'));
MediaPlayer1.DeviceType := dtAutoSelect;
MediaPlayer1.FileName := (ExtractFilePath(Application.ExeName)+ 'Temp.wav');
MediaPlayer1.Open;
MediaPlayer1.StartRecording;
BtStart.Enabled:=false;
BtStop.Enabled:=true;
except
BtStart.Enabled:=True;
BtStop.Enabled:=false;
Application.MessageBox('媒体设备初始化失败!','错误',MB_ICONERROR+MB_OK);
end;
end;
procedure TForm1.BtStopClick(Sender: TObject);
begin
try
MediaPlayer1.Stop;
MediaPlayer1.Save;
MediaPlayer1.Close;
Application.MessageBox('声音录制完毕!','信息',MB_ICONINFORMATION+MB_OK);
BtStart.Enabled:=True;
BtStop.Enabled:=false;
except
Application.MessageBox('保存声音文件出错!','错误',MB_ICONERROR+MB_OK);
BtStart.Enabled:=True;
BtStop.Enabled:=false;
end;
end;
end.
补充:1、录制的文件播放时可能要把音频属性的Wav调大。
2、如果系统安装了其它一些音频驱动程序,则可能录制的Wav文件大小为零,但会同时生成一个TMP结尾的
文件,将其扩展名改为Wav就是录制的声音文件。但这种情况很少发生。(机会几乎为零^-^)
3、本程序在运行解霸和Replayer下录制声音通过。
来自:minkerui, 时间:2002-2-24 15:44:00, ID:939287
我这里给你贴一个我写的程序段,看不明白就算了。
// 全局变量
var
BufferFinished : boolean;
// indicates current record buffer is full
.
UserStopRecord: boolean;
Recording: boolean;
WaveInHandle: HWaveIn;
CurrentUsingBuffer: integer;
WaveInHeader1: TWaveHdr;
WaveInHeader2: TWaveHdr;
RecordBufferSize: integer;
TotalRecordedSize: DWORD;
//进行录音
procedure TDlgRecord.BtnStartClick(Sender: TObject);
var
TempInt, TempCode: integer;
TempFileName: string;
MMR: MMResult;
MyWaveFormat: TWaveFormatEx;
begin
PrgsBarSpace.Position := 0;
Recording := false;
OldDiskFree := DiskFree (RecordDrive);
with RecordWaveFormatdo
begin
if RdoBtnMono.Checked = true then
Channels := 1
else
Channels := 2;
if RdoBtn8Bit.Checked = true then
BitsPerSample := 8
else
BitsPerSample := 16;
Val (EditFrequency.Text, TempInt, TempCode);
if TempCode <> 0 then
begin
Application.MessageBox ('无效数值', '错误', MB_Ok);
exit;
end
else
if TempInt > 48000 then
begin
Application.MessageBox('不能大于48000赫兹', '错误', MB_Ok);
exit;
end
else
begin
SamplesPerSecond := TempInt;
end;
BytesPerSecond := SamplesPerSecond * Channels * BitsPerSample div
8;
BlockAlign := BitsPerSample * Channels div 8
end;
TempFileName := TempFileNameGenerator (Self.TempPath, 'WM_', 'TMP',
5);
AssignFile (RecordFile, TempFileName);
Rewrite (RecordFile, 1);
if IOResult <> 0 then
begin
Application.Messagebox ('无法创建暂时文件,请检查临时目录设定。',
'严重错误', MB_OK);
exit;
end;
RecordFileName := TempFileName;
RecordSuccess := false;
// 由于文件名已经改变,所以在这里修改该变量。
// Preparation jobs here
SttTextElapsedTime.Caption := '00:00:00';
ElapsedHours := 0;
ElapsedMinutes := 0;
ElapsedSeconds := 0;
CurrentUsingBuffer := 1;
TotalRecordedSize := 0;
BufferFinished := false;
UserStopRecord := false;
RecordBufferSize := RecordWaveFormat.BytesPerSecond * 2;
// for 2 se
conds
Buffer1 := nil;
Buffer2 := nil;
try
GetMem (Buffer1, RecordBufferSize);
except
Application.MessageBox ('内存不足,分配第一缓冲区失败。', '错误',
MB_OK);
end;
try
GetMem (Buffer2, RecordBufferSize);
except
Application.MessageBox ('内存不足,分配第二缓冲区失败。', '错误',
MB_OK);
end;
if (Buffer1 = nil) or (Buffer2 = nil) then
begin
CloseFile (RecordFile);
exit;
end;
MyWaveFormat.wFormatTag := WAVE_FORMAT_PCM;
MyWaveFormat.nChannels := RecordWaveFormat.Channels;
MyWaveFormat.nSamplesPerSec := RecordWaveFormat.SamplesPerSecond;
MyWaveFormat.nAvgBytesPerSec := RecordWaveFormat.BytesPerSecond;
MyWaveFormat.nBlockAlign := RecordWaveFormat.BlockAlign;
MyWaveFormat.wBitsPerSample := RecordWaveFormat.BitsPerSample;
MyWaveFormat.cbSize := 0;
MMR := waveInOpen (Addr (waveInHandle),
SelectedDevice,
Addr (MyWaveFormat),
DWORD (Addr (WaveInCallBack)),
0,
CALLBACK_FUNCTION);
if MMR <> MMSYSERR_NOERROR then
begin
FreeMem (Buffer1);
FreeMem (Buffer2);
RecordBufferSize := 0;
CloseFile (RecordFile);
Application.MessageBox ('无法打开输入设备,请检查设定。', '错误',
MB_OK);
exit;
end;
waveInHeader1.lpData := Buffer1;
waveInHeader1.dwBufferLength := RecordBufferSize;
waveInHeader1.dwBytesRecorded := 0;
waveInHeader1.dwUser := 0;
// 32 bits of user data
waveInHeader1.dwFlags := 0;
waveInHeader1.dwLoops := 0;
waveInHeader1.lpNext := nil;
// reserved;
must be zero
waveInHeader1.reserved := 0;
// reserved;
must be zero
MMR := waveInPrepareHeader (waveInHandle, Addr (waveInHeader1),
sizeof (waveInHeader1));
if MMR <> MMSYSERR_NOERROR then
begin
FreeMem (Buffer1);
FreeMem (Buffer2);
RecordBufferSize := 0;
CloseFile (RecordFile);
Application.MessageBox ('第一录音缓冲区准备出错。', '错误', MB_OK)
;
exit;
end;
waveInHeader2.lpData := Buffer2;
waveInHeader2.dwBufferLength := RecordBufferSize;
waveInHeader2.dwBytesRecorded := 0;
waveInHeader2.dwUser := 0;
// 32 bits of user data
waveInHeader2.dwFlags := 0;
waveInHeader2.dwLoops := 0;
waveInHeader2.lpNext := nil;
// reserved;
must be zero
waveInHeader2.reserved := 0;
// reserved;
must be zero
MMR := waveInPrepareHeader (waveInHandle, Addr (waveInHeader2),
sizeof (waveInHeader2));
if MMR <> MMSYSERR_NOERROR then
begin
waveInUnprepareHeader (waveInHandle, Addr (waveInHeader1), sizeof(
waveInHeader1));
FreeMem (Buffer1);
FreeMem (Buffer2);
RecordBufferSize := 0;
CloseFile (RecordFile);
Application.MessageBox ('第二录音缓冲区准备出错。', '错误', MB_OK)
;
exit;
end;
MMR := waveInAddBuffer (WaveInHandle, Addr (waveInHeader1), sizeof (
waveInHeader1));
if MMR <> MMSYSERR_NOERROR then
begin
waveInUnprepareHeader (waveInHandle, Addr (waveInHeader1), sizeof(
waveInHeader1));
waveInUnprepareHeader (waveInHandle, Addr (waveInHeader2), sizeof(
waveInHeader2));
FreeMem (Buffer1);
FreeMem (Buffer2);
RecordBufferSize := 0;
CloseFile (RecordFile);
Application.MessageBox ('添加第一缓冲区出错。', '错误', MB_OK);
exit;
end;
MMR := waveInAddBuffer (WaveInHandle, Addr (waveInHeader2), sizeof (
waveInHeader2));
if MMR <> MMSYSERR_NOERROR then
begin
waveInUnprepareHeader (waveInHandle, Addr (waveInHeader1), sizeof(
waveInHeader1));
waveInUnprepareHeader (waveInHandle, Addr (waveInHeader2), sizeof(
waveInHeader2));
FreeMem (Buffer1);
FreeMem (Buffer2);
RecordBufferSize := 0;
CloseFile (RecordFile);
Application.MessageBox ('添加第二缓冲区出错。', '错误', MB_OK);
exit;
end;
TimerRecording.Enabled := true;
// Record has begun.
Recording := true;
MMR := waveInStart (waveInHandle);
if MMR <> MMSYSERR_NOERROR then
begin
waveInUnprepareHeader (waveInHandle, Addr (waveInHeader1), sizeof(
waveInHeader1));
waveInUnprepareHeader (waveInHandle, Addr (waveInHeader2), sizeof(
waveInHeader2));
FreeMem (Buffer1);
FreeMem (Buffer2);
RecordBufferSize := 0;
CloseFile (RecordFile);
Recording := false;
TimerRecording.Enabled := false;
Application.MessageBox ('未能开始录音。', '错误', MB_OK);
exit;
end;
// 应该在这里开始创建线程.
// 需要传递参数: RecordFile, Buffer1, Buffer2,
with TMediaRecordThread.Create (Addr(RecordFile), Buffer1, Buffer2)
do
OnTerminate := ThreadRecordStop;
// disable/enable controls
BtnCancel.Enabled := false;
BtnStart.Enabled := false;
GrpBoxChannel.Enabled := false;
LBFrequency.Enabled := false;
EditFrequency.Enabled := false;
LstBoxFrequency.Enabled := false;
GrpBoxSample.Enabled := false;
BtnStop.Enabled := true;
end;