Sound

  1. Low Level WaveIn routine
  2. Playing a wave sound from a resource file[UPD]
  3. D2: Win95 + Speaker + Sound := possible
  4. Convert Wave format file to Raw data format
  5. Wave File format help[NEW]

Low Level WaveIn routine

From: John_Mertus@brown.edu (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.

Playing a wave sound from a resource file[UPD]

From: Stefan.Westner@stud.uni-bamberg.de (Stefan Westner)

In article <01bbde3a$960b1a00$1500dece@dbrown.ee.net>, dbrown@ee.net 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: ken@tiva.demon.co.uk

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.

D2: Win95 + Speaker + Sound := possible

From: jatkins@paktel.compulink.co.uk (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.

Convert Wave format file to Raw data format

This can be found on the Convert Page.

Wave File format help[NEW]

From: BerndCordes@t-online.de

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.