Sound
From: [email protected] (John_Mertus)
A while back someone asked for code that allows one to process data from the input of a soundcard. Hopefully this unit will show how to do this.
Enclosed is RECUNIT that is a unit that does the hard work, one calls it by
Var
WaveRecorder : TWaveRecorder;
WaveRecorder := TwaveRecorder(2048, 4); // 4 buffers of size 2048 bytes
{ Set the sampling parameters }
With WaveRecorder.pWavefmtEx Do
Begin
wFormatTag := WAVE_FORMAT_PCM;
nChannels := 1;
nSamplesPerSec := 20000;
wBitsPerSample := 16;
nAvgBytesPerSec := nSamplesPerSec*(wBitsPerSample div 8)*nChannels;
End;
// Next is a kludge since I don't know how to get the address of
// the object itself
WaveRecorder.SetupRecord(@WaveRecorder);
// Now start recording with
WaveRecorder.StartRecord;
... Each time a buffer is full, the WaveRecorder.Processbuffer
routine is called.
// Stop recording with
WaveRecorder.StopRecord;
WaveRecorder.Destroy;
{
File Name: RECUNIT.PAS V 1.01
Created: Aug 19 1996 at 21:56 on IBM ThinkPad
Revision #7: Aug 22 1997, 15:01 on IBM ThinkPad
-John Mertus
This unit contains necessary routines for doing recording.
Version 1.00 is initial release
1.01 Added TWaveInGetErrorText
}
{-----------------Unit-RECUNIT---------------------John Mertus---Aug 96---}
Unit RECUNIT;
{*************************************************************************}
Interface
Uses
Windows, MMSystem, SysUtils, MSACM;
{ The following defines a class TWaveRecorder for sound card input. }
{ It is expected that a new class is derived from TWaveRecorder }
{ that overrides TWaveRecorder.ProcessBuffer. After the recorder is }
{ started, the procedure is called whenever a buffer of data has }
{ been sampled. }
Const
MAX_BUFFERS = 8;
type
PWaveRecorder = ^TWaveRecorder;
TWaveRecorder = class(TObject)
Constructor Create(BfSize, TotalBuffers : Integer);
Destructor Destroy; Override;
Procedure ProcessBuffer(uMsg : Word; P : Pointer; n : Integer);
Virtual;
private
fBufferSize : Integer; // Requsted size of buffer
BufIndex : Integer;
fTotalBuffers : Integer;
pWaveHeader : Array [0..MAX_BUFFERS-1] of PWAVEHDR;
hWaveHeader : Array [0..MAX_BUFFERS-1] of THANDLE;
hWaveBuffer : Array [0..MAX_BUFFERS-1] of THANDLE;
hWaveFmtEx : THANDLE;
dwByteDataSize : DWORD;
dwTotalWaveSize : DWORD;
RecordActive : Boolean;
bDeviceOpen : Boolean;
{ Functions that no one needs to know about }
Function InitWaveHeaders : Boolean;
Function AllocPCMBuffers : Boolean;
Procedure FreePCMBuffers;
Function AllocWaveFormatEx : Boolean;
Procedure FreeWaveFormatEx;
Function AllocWaveHeaders : Boolean;
Procedure FreeWaveHeader;
Function AddNextBuffer : Boolean;
Procedure CloseWaveDeviceRecord;
public
{ Public declarations }
pWaveFmtEx : PWaveFormatEx;
WaveBufSize : Integer; // Size aligned to nBlockAlign Field
InitWaveRecorder : Boolean;
RecErrorMessage : String;
QueuedBuffers,
ProcessedBuffers : Integer;
pWaveBuffer : Array [0..MAX_BUFFERS-1] of lpstr;
WaveIn : HWAVEIN; { Wavedevice handle }
Procedure StopRecord;
Function StartRecord : Boolean;
Function SetupRecord(P : PWaveRecorder) : Boolean;
end;
{*************************************************************************}
implementation
{-------------TWaveInGetErrorText------------John Mertus---14-June--97--}
Function TWaveInGetErrorText(iErr : Integer) : String;
{ This puts the WaveIn error messages in a Pascal type format. }
{ iErr is the error number }
{ }
{**********************************************************************}
Var
PlayInErrorMsgC : Array [0..255] of Char;
Begin
waveInGetErrorText(iErr,PlayInErrorMsgC,255);
TWaveInGetErrorText := StrPas(PlayInErrorMsgC);
End;
{-------------InitWaveHeaders----------------John Mertus---14-June--97--}
Function TWaveRecorder.AllocWaveFormatEx : Boolean;
{ Allocate the larget format size required from installed ACM's }
{ }
{**********************************************************************}
Var
MaxFmtSize : UINT;
BEGIN
{ maxFmtSize is the sum of sizeof(WAVEFORMATEX) + pwavefmtex.cbSize }
If( acmMetrics( 0, ACM_METRIC_MAX_SIZE_FORMAT, maxFmtSize ) <> 0) Then
Begin
RecErrorMessage := 'Error getting the max compression format size';
AllocWaveFormatEx := False;
Exit;
End;
{ allocate the WAVEFMTEX structure }
hWaveFmtEx := GlobalAlloc(GMEM_MOVEABLE, maxFmtSize);
If (hWaveFmtEx = 0) Then
Begin
RecErrorMessage := 'Error allocating memory for WaveFormatEx structure';
AllocWaveFormatEx := False;
Exit;
End;
pWaveFmtEx := PWaveFormatEx(GlobalLock(hWaveFmtEx));
If (pWaveFmtEx = Nil) Then
Begin
RecErrorMessage := 'Error locking WaveFormatEx memory';
AllocWaveFormatEx := False;
Exit;
End;
{ initialize the format to standard PCM }
ZeroMemory( pwavefmtex, maxFmtSize );
pwavefmtex.wFormatTag := WAVE_FORMAT_PCM;
pwavefmtex.nChannels := 1;
pwavefmtex.nSamplesPerSec := 20000;
pwavefmtex.nBlockAlign := 1;
pwavefmtex.wBitsPerSample := 16;
pwavefmtex.nAvgBytesPerSec := pwavefmtex.nSamplesPerSec*
(pwavefmtex.wBitsPerSample div
8)*pwavefmtex.nChannels;
pwavefmtex.cbSize := 0;
{ Success, go home }
AllocWaveFormatEx := True;
end;
{-------------InitWaveHeaders----------------John Mertus---14-June--97--}
Function TWaveRecorder.InitWaveHeaders : Boolean;
{ Allocate memory, zero out wave headers and initialize }
{ }
{**********************************************************************}
Var
i : Integer;
BEGIN
{ make the wave buffer size a multiple of the block align... }
WaveBufSize := fBufferSize - (fBufferSize mod pwavefmtex.nBlockAlign);
{ Set the wave headers }
For i := 0 to fTotalBuffers-1 Do
With pWaveHeader[i]^ Do
Begin
lpData := pWaveBuffer[i]; // address of the waveform buffer
dwBufferLength := WaveBufSize; // length, in bytes, of the buffer
dwBytesRecorded := 0; // see below
dwUser := 0; // 32 bits of user data
dwFlags := 0; // see below
dwLoops := 0; // see below
lpNext := Nil; // reserved; must be zero
reserved := 0; // reserved; must be zero
End;
InitWaveHeaders := TRUE;
END;
{-------------AllocWaveHeader----------------John Mertus---14-June--97--}
Function TWaveRecorder.AllocWaveHeaders : Boolean;
{ Allocate and lock header memory }
{ }
{***********************************************************************}
Var
i : Integer;
BEGIN
For i := 0 to fTotalBuffers-1 Do
begin
hwaveheader[i] := GlobalAlloc( GMEM_MOVEABLE or GMEM_SHARE or
GMEM_ZEROINIT, sizeof(TWAVEHDR));
if (hwaveheader[i] = 0) Then
begin
{ NOTE: This could lead to a memory leak, fix someday }
RecErrorMessage := 'Error allocating wave header memory';
AllocWaveHeaders := FALSE;
Exit;
end;
pwaveheader[i] := GlobalLock (hwaveheader[i]);
If (pwaveheader[i] = Nil ) Then
begin
{ NOTE: This could lead to a memory leak, fix someday }
RecErrorMessage := 'Could not lock header memory for recording';
AllocWaveHeaders := FALSE;
Exit;
end;
End;
AllocWaveHeaders := TRUE;
END;
{---------------FreeWaveHeader----------------John Mertus---14-June--97--}
Procedure TWaveRecorder.FreeWaveHeader;
{ Just free up the memory AllocWaveHeaders allocated. }
{ }
{***********************************************************************}
Var
i : Integer;
BEGIN
For i := 0 to fTotalBuffers-1 Do
begin
If (hWaveHeader[i] <> 0) Then
Begin
GlobalUnlock(hwaveheader[i]);
GlobalFree(hwaveheader[i]);
hWaveHeader[i] := 0;
End
end;
END;
{
{-------------AllocPCMBuffers----------------John Mertus---14-June--97--}
Function TWaveRecorder.AllocPCMBuffers : Boolean;
{ Allocate and lock the waveform memory. }
{ }
{***********************************************************************}
Var
i : Integer;
BEGIN
For i := 0 to fTotalBuffers-1 Do
begin
hWaveBuffer[i] := GlobalAlloc( GMEM_MOVEABLE or GMEM_SHARE, fBufferSize
);
If (hWaveBuffer[i] = 0) Then
begin
{ Possible Memory Leak here }
RecErrorMessage := 'Error allocating wave buffer memory';
AllocPCMBuffers := False;
Exit;
end;
pWaveBuffer[i] := GlobalLock(hWaveBuffer[i]);
If (pWaveBuffer[i] = Nil) Then
begin
{ Possible Memory Leak here }
RecErrorMessage := 'Error Locking wave buffer memory';
AllocPCMBuffers := False;
Exit;
end;
pWaveHeader[i].lpData := pWaveBuffer[i];
End;
AllocPCMBuffers := TRUE;
END;
{--------------FreePCMBuffers----------------John Mertus---14-June--97--}
Procedure TWaveRecorder.FreePCMBuffers;
{ Free up the meomry AllocPCMBuffers used. }
{ }
{***********************************************************************}
Var
i : Integer;
BEGIN
For i := 0 to fTotalBuffers-1 Do
begin
If (hWaveBuffer[i] <> 0) Then
Begin
GlobalUnlock( hWaveBuffer[i] );
GlobalFree( hWaveBuffer[i] );
hWaveBuffer[i] := 0;
pWaveBuffer[i] := Nil;
End;
end;
END;
{--------------FreeWaveFormatEx--------------John Mertus---14-June--97--}
Procedure TWaveRecorder.FreeWaveFormatEx;
{ This just frees up the ExFormat headers }
{ }
{***********************************************************************}
BEGIN
If (pWaveFmtEx = Nil) Then Exit;
GlobalUnlock(hWaveFmtEx);
GlobalFree(hWaveFmtEx);
pWaveFmtEx := Nil;
END;
{-------------TWaveRecorder.Create------------John Mertus-----Aug--97--}
Constructor TWaveRecorder.Create(BFSize, TotalBuffers : Integer);
{ This sets up the wave headers, initializes the data pointers and }
{ allocates the sampling buffers }
{ BFSize is the size of the buffer in BYTES }
{ }
{**********************************************************************}
Var
i : Integer;
BEGIN
Inherited Create;
For i := 0 to fTotalBuffers-1 Do
Begin
hWaveHeader[i] := 0;
hWaveBuffer[i] := 0;
pWaveBuffer[i] := Nil;
pWaveFmtEx := Nil;
End;
fBufferSize := BFSize;
fTotalBuffers := TotalBuffers;
{ allocate memory for wave format structure }
If(Not AllocWaveFormatEx) Then
Begin
InitWaveRecorder := FALSE;
Exit;
End;
{ find a device compatible with the available wave characteristics }
If (waveInGetNumDevs < 1 ) Then
Begin
RecErrorMessage := 'No wave audio recording devices found';
InitWaveRecorder := FALSE;
Exit;
End;
{ allocate the wave header memory }
If (Not AllocWaveHeaders) Then
Begin
InitWaveRecorder := FALSE;
Exit;
End;
{ allocate the wave data buffer memory }
If (Not AllocPCMBuffers) Then
Begin
InitWaveRecorder := FALSE;
Exit;
End;
InitWaveRecorder := TRUE;
END;
{---------------------Destroy----------------John Mertus---14-June--97--}
Destructor TWaveRecorder.Destroy;
{ Just free up all memory allocated by InitWaveRecorder. }
{ }
{***********************************************************************}
BEGIN
FreeWaveFormatEx;
FreePCMBuffers;
FreeWaveHeader;
Inherited Destroy;
END;
{------------CloseWaveDeviceRecord------------John Mertus---14-June--97--}
Procedure TWaveRecorder.CloseWaveDeviceRecord;
{ Just close up the waveform device. }
{ }
{***********************************************************************}
Var
i : Integer;
BEGIN
{ if the device is already closed, just return }
If (Not bDeviceOpen) Then Exit;
{ unprepare the headers }
For i := 0 to fTotalBuffers-1 Do
If (waveInUnprepareHeader(WaveIn, pWaveHeader[i], sizeof(TWAVEHDR)) <> 0 )
Then
RecErrorMessage := 'Error in waveInUnprepareHeader';
{ save the total size recorded and update the display }
dwTotalwavesize := dwBytedatasize;
{ close the wave input device }
If (waveInClose(WaveIn) <> 0) Then
RecErrorMessage := 'Error closing input device';
{ tell this function we are now closed }
bDeviceOpen := FALSE;
END;
{------------------StopRecord-----------------John Mertus---14-June--97--}
Procedure TWaveRecorder.StopRecord;
{ This stops the recording and sets some flags. }
{ }
{***********************************************************************}
Var
iErr : Integer;
BEGIN
RecordActive := False;
iErr := waveInReset(WaveIn);
{ stop recording and return queued buffers }
If (iErr <> 0) Then
Begin
RecErrorMessage := 'Error in waveInReset';
End;
CloseWaveDeviceRecord;
END;
{--------------AddNextBuffer------------------John Mertus---14-June--97--}
Function TWaveRecorder.AddNextBuffer : Boolean;
{ This adds a buffer to the input queue and toggles buffer index. }
{ }
{***********************************************************************}
Var
iErr : Integer;
BEGIN
{ queue the buffer for input }
iErr := waveInAddBuffer(WaveIn, pwaveheader[bufindex], sizeof(TWAVEHDR));
If (iErr <> 0) Then
begin
StopRecord;
RecErrorMessage := 'Error adding buffer' + TWaveInGetErrorText(iErr);
AddNextBuffer := FALSE;
Exit;
end;
{ toggle for next buffer }
bufindex := (bufindex+1) mod fTotalBuffers;
QueuedBuffers := QueuedBuffers + 1;
AddNextBuffer := TRUE;
END;
{--------------BufferDoneCallBack------------John Mertus---14-June--97--}
Procedure BufferDoneCallBack(
hW : HWAVE; // handle of waveform device
uMsg : DWORD; // sent message
dwInstance : DWORD; // instance data
dwParam1 : DWORD; // application-defined parameter
dwParam2 : DWORD // application-defined parameter
); stdcall;
{ This is called each time the wave device has info, e.g. fills a buffer}
{ }
{***********************************************************************}
Var
BaseRecorder : PWaveRecorder;
BEGIN
BaseRecorder := Pointer(DwInstance);
With BaseRecorder^ Do
Begin
ProcessBuffer(uMsg, pWaveBuffer[ProcessedBuffers Mod fTotalBuffers],
WaveBufSize);
If (RecordActive) Then
Case uMsg of
WIM_DATA:
Begin
BaseRecorder.AddNextBuffer;
ProcessedBuffers := ProcessedBuffers+1;
End;
End;
End;
END;
{------------------StartRecord---------------John Mertus---14-June--97--}
Function TWaveRecorder.StartRecord : Boolean;
{ This does all the work in creating the waveform recorder. }
{ }
{***********************************************************************}
Var
iErr, i : Integer;
BEGIN
{ start recording to first buffer }
iErr := WaveInStart(WaveIn);
If (iErr <> 0) Then
begin
CloseWaveDeviceRecord;
RecErrorMessage := 'Error starting wave record: ' +
TWaveInGetErrorText(iErr);
end;
RecordActive := TRUE;
{ queue the next buffers }
For i := 1 to fTotalBuffers-1 Do
If (Not AddNextBuffer) Then
Begin
StartRecord := FALSE;
Exit;
End;
StartRecord := True;
END;
{-----------------SetupRecord---------------John Mertus---14-June--97--}
Function TWaveRecorder.SetupRecord(P : PWaveRecorder) : Boolean;
{ This does all the work in creating the waveform recorder. }
{ }
{***********************************************************************}
Var
iErr, i : Integer;
BEGIN
dwTotalwavesize := 0;
dwBytedatasize := 0;
bufindex := 0;
ProcessedBuffers := 0;
QueuedBuffers := 0;
{ open the device for recording }
iErr := waveInOpen(@WaveIn, WAVE_MAPPER, pWaveFmtEx,
Integer(@BufferDoneCallBack),
Integer(P), CALLBACK_FUNCTION + WAVE_ALLOWSYNC );
If (iErr <> 0) Then
Begin
RecErrorMessage := 'Could not open the input device for recording: ' + ^M
+
TWaveInGetErrorText(iErr);
SetupRecord := FALSE;
Exit;
End;
{ tell CloseWaveDeviceRecord() that the device is open }
bDeviceOpen := TRUE;
{ prepare the headers }
InitWaveHeaders();
For i := 0 to fTotalBuffers-1 Do
Begin
iErr := waveInPrepareHeader( WaveIn, pWaveHeader[I], sizeof(TWAVEHDR));
If (iErr <> 0) Then
begin
CloseWaveDeviceRecord;
RecErrorMessage := 'Error preparing header for recording: ' + ^M +
TWaveInGetErrorText(iErr);
SetupRecord := FALSE;
Exit;
end;
End;
{ add the first buffer }
If (Not AddNextBuffer) Then
begin
SetupRecord := FALSE;
Exit;
end;
SetupRecord := TRUE;
END;
{-----------------ProcessBuffer---------------John Mertus---14-June--97--}
Procedure TWaveRecorder.ProcessBuffer(uMsg: Word; P : Pointer; n :
Integer);
{ Dummy procedure that is called when a buffer is ready. }
{ }
{***********************************************************************}
BEGIN
END;
END.
From: [email protected] (Stefan Westner)
In article <[email protected]>, [email protected] says... I am attempting to have a wave file play when a button is clicked, in my Delphi application. Rather than install the wave file and use the PlaySound() API call, I'd like to put it into a resource file so that it plays with only the EXE present.
you need a resource compiler (i. E. Resource Workshop ) and add an user-defined-resource WAVE. You can play the resource-file in your program using
var FindHandle, ResHandle: THandle;
ResPtr: Pointer;
begin
FindHandle:=FindResource(HInstance, '<Name of your Ressource>', 'WAVE');
if FindHandle<>0 then begin
ResHandle:=LoadResource(HInstance, FindHandle);
if ResHandle<>0 then begin
ResPtr:=LockResource(ResHandle);
if ResPtr<>Nil then
SndPlaySound(PChar(ResPtr), snd_ASync or snd_Memory);
UnlockResource(ResHandle);
end;
FreeResource(FindHandle);
end;
end;
From: [email protected]
I've been trying to do this for the last hour, and have found a better way (in D3) :
PlaySound('S1', HInstance, SND_RESOURCE or SND_ASYNC);
where S1 is the ID of the sound.
One line of code, it does all the finding, loading, locking, unlocking and freeing itself.
From: [email protected] (John Atkins)
I use the following in Win95.procedure Sound(Freq : Word);
var
B : Byte;
begin
if Freq > 18 then
begin
Freq := Word(1193181 div LongInt(Freq));
B := Byte(GetPort($61));
if (B and 3) = 0 then
begin
SetPort($61, Word(B or 3));
SetPort($43, $B6);
end;
SetPort($42, Freq);
SetPort($42, Freq shr 8);
end;
end;
procedure NoSound;
var
Value: Word;
begin
Value := GetPort($61) and $FC;
SetPort($61, Value);
end;
procedure SetPort(address, Value:Word);
var
bValue: byte;
begin
bValue := trunc(Value and 255);
asm
mov dx, address
mov al, bValue
out dx, al
end;
end;
function GetPort(address:word):word;
var
bValue: byte;
begin
asm
mov dx, address
in al, dx
mov bValue, al
end;
GetPort := bValue;
end;
Under WinNT, Beep(Tone, Duration) can be used.
This can be found on the
Convert Page.From: [email protected]
Here you go:
TWaveHeader = record
Marker1: Array[0..3] of Char;
BytesFollowing: LongInt;
Marker2: Array[0..3] of Char;
Marker3: Array[0..3] of Char;
Fixed1: LongInt;
FormatTag: Word;
Channels: Word;
SampleRate: LongInt;
BytesPerSecond: LongInt;
BytesPerSample: Word;
BitsPerSample: Word;
Marker4: Array[0..3] of Char;
DataBytes: LongInt;
end;
To create your own WAV:
DataBytes := Channels;
DataBytes := DataBytes * SampleRate;
DataBytes := DataBytes * Resolution;
DataBytes := DataBytes div 8;
DataBytes := DataBytes * Duration;
DataBytes := DataBytes div 1000;
WaveHeader.Marker1 := 'RIFF';
WaveHeader.BytesFollowing := DataBytes + 36;
WaveHeader.Marker2 := 'WAVE';
WaveHeader.Marker3 := 'fmt ';
WaveHeader.Fixed1 := 16;
WaveHeader.FormatTag := 1;
WaveHeader.SampleRate := SampleRate;
WaveHeader.Channels := Channels;
WaveHeader.BytesPerSecond := Channels;
WaveHeader.BytesPerSecond := WaveHeader.BytesPerSecond * SampleRate;
WaveHeader.BytesPerSecond := WaveHeader.BytesPerSecond * Resolution;
WaveHeader.BytesPerSecond := WaveHeader.BytesPerSecond div 8;
WaveHeader.BytesPerSample := Channels * Resolution div 8;
WaveHeader.BitsPerSample := Resolution;
WaveHeader.Marker4 := 'data';
WaveHeader.DataBytes := DataBytes;
The rest of the file is the wave data. Order is low-high for left channel, low-high for right channel, and so on. For mono or 8 bit files make the respective changes.
Please email me and tell me if you liked this page.
Last modified 04/09/1998 11:26:39