audioio.pas

语音压缩和播放控件

{**********************************************************************}
BEGIN
   With FWaveFmtEx Do
     Begin
        nBlockAlign := (wBitsPerSample div 8)*nchannels;
        nAvgBytesPerSec := nSamplesPerSec*nBlockAlign;
     End;

   FBufferSize := FRequestedBufferSize - (FRequestedBufferSize mod FWaveFmtEx.nBlockAlign);
END;

{-------------InitWaveHeaders----------------John Mertus---14-June--97--}

   Function TAudioIO.InitWaveHeaders : Boolean;

{ This just initalizes the waveform headers, no memory allocated        }
{									}
{**********************************************************************}
Var
  i : Integer;

BEGIN
  { This should not be necessary, but to be safe... }
  MakeWaveFmtConsistent;

  { Set the wave headers }
  For i := 0 to FNumBuffers-1 Do
    With WaveHdr[i]^ Do
      Begin
        lpData := WaveBuffer[i];         // address of the waveform buffer
        dwBufferLength := FBufferSize;   // 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;


{-------------AllocPCMBuffers----------------John Mertus---14-June--97--}

   Function TAudioIO.AllocPCMBuffers : Boolean;

{ Allocate and lock the waveform memory.                                }
{									}
{***********************************************************************}
Var
  i : Integer;

BEGIN
  For i := 0 to fNumBuffers-1 Do
    begin
      hWaveBuffer[i] := GlobalAlloc( GMEM_MOVEABLE or GMEM_SHARE, fBufferSize );
      If (hWaveBuffer[i] = 0) Then
	begin
          FreePCMBuffers;
          ErrorMessage := 'Error allocating wave buffer memory';
          AllocPCMBuffers := False;
          Exit;
	end;

      WaveBuffer[i] := GlobalLock(hWaveBuffer[i]);
      If (WaveBuffer[i] = Nil) Then
	begin
          FreePCMBuffers;
          ErrorMessage := 'Error Locking wave buffer memory';
          AllocPCMBuffers := False;
          Exit;
	end;
      WaveHdr[i].lpData := WaveBuffer[i];
    End;

  AllocPCMBuffers := TRUE;
END;

{--------------FreePCMBuffers----------------John Mertus---14-June--97--}

   Function TAudioIO.FreePCMBuffers : Boolean;

{ Free up the meomry AllocPCMBuffers used.                              }
{									}
{***********************************************************************}
Var
  i : Integer;

BEGIN

  Result := FALSE;

  For i := 0 to MaxBuffers-1 Do
    begin
      If (hWaveBuffer[i] <> 0) Then
        Begin
  	  GlobalUnlock(hWaveBuffer[i] );
	  GlobalFree(hWaveBuffer[i] );
          hWaveBuffer[i] := 0;
          WaveBuffer[i] := Nil;
          Result := TRUE;
        End;
    end;

END;
{-------------AllocWaveHeaders---------------John Mertus---14-June--97--}

   Function TAudioIO.AllocWaveHeaders : Boolean;

{ Allocate and lock header memory                                       }
{									}
{***********************************************************************}
Var
  i : Integer;

BEGIN
  For i := 0 to MAXBUFFERS-1 Do
    begin
      hwaveheader[i] := GlobalAlloc( GMEM_MOVEABLE or GMEM_SHARE or GMEM_ZEROINIT, sizeof(TWAVEHDR));
      if (hwaveheader[i] = 0) Then
        begin
          FreeWaveHeaders;
          ErrorMessage := 'Error allocating wave header memory';
          AllocWaveHeaders := FALSE;
          Exit;
        end;

      WaveHdr[i] := GlobalLock (hwaveheader[i]);
      If (WaveHdr[i] = Nil ) Then
        begin
          FreeWaveHeaders;
          ErrorMessage := 'Could not lock header memory for recording';
          AllocWaveHeaders := FALSE;
          Exit;
        end;

    End;

  AllocWaveHeaders := TRUE;
END;

{---------------FreeWaveHeaders---------------John Mertus---14-June--97--}

   Procedure TAudioIO.FreeWaveHeaders;

{ Just free up the memory AllocWaveHeaders allocated.                   }
{									}
{***********************************************************************}
Var
  i : Integer;

BEGIN
  For i := 0 to MAXBUFFERS-1 Do
    begin
      If (hWaveHeader[i] <> 0) Then
        Begin
          GlobalUnlock(hwaveheader[i]);
          GlobalFree(hwaveheader[i]);
          hWaveHeader[i] := 0;
          WaveHdr[i] := Nil;
        End
    end;
END;

{--------------------StopAtOnce-------------John Mertus---14-June--97--}

   Procedure TAudioIO.StopAtOnce;

{ Write the buffer to the wave device and toggel buffer index.          }
{									}
{**********************************************************************}
BEGIN
   Active := False;
   ContinueProcessing := FALSE;
END;

{--------------------StopGracefully---------John Mertus---14-June--97--}

   Procedure TAudioIO.StopGracefully;

{ Write the buffer to the wave device and toggel buffer index.          }
{									}
{**********************************************************************}
BEGIN
  ContinueProcessing := FALSE;
END;

{-----------------ElapsedTime----------------John Mertus---14-June--97--}

   Function TAudioOut.ElapsedTime : Real;

{ This function returns the time since start of playout.                }
{									}
{**********************************************************************}
Var
  pmmt  : TMMTime;

BEGIN
  If (Active) Then
    Begin
      pmmt.wType := TIME_SAMPLES;
      If (waveOutGetPosition(WaveHandle, @pmmt, Sizeof(TMMTime)) <> 0) Then
         Result := 0
      Else
         Result := pmmt.Sample/FrameRate;
    End
  Else
    Result := 0;
END;

{---------------SetPaused-----------------------John Mertus Oct 96---}

   Procedure TAudioOut.SetPaused(Value : Boolean);

{  This pauses or restarts the output.                                  }
{									}
{**********************************************************************}
BEGIN
  FPaused := Value;
  If (Not Active) Then Exit;
  If FPaused Then
    WaveOutPause(WaveHandle)
  Else
    WaveOutReStart(WaveHandle);
END;

{-------------CloseWaveDevice----------------John Mertus---14-June--97--}

   Procedure TAudioOut.CloseWaveDevice;

{ Closes the wave output device.                                        }
{									}
{**********************************************************************}
Var
  i : Integer;

BEGIN
{ unprepare the headers }
  Active := FALSE;
  Paused := FALSE;
  For i := 0 to FNumBuffers-1 Do
    waveOutUnprepareHeader( WaveHandle, WaveHdr[i], sizeof(TWAVEHDR));

{ close the device }
   waveOutClose(WaveHandle);
   WaveDeviceOpen := FALSE;

END;

{-------------SetupOutput--------------------John Mertus---14-June--97--}

   Function TAudioOut.Setup(Var TS : TAudioOut) : Boolean;

{ This function just sets up the board for output.                      }
{									}
{**********************************************************************}
Var
  iErr       : Integer;
  i          : Integer;

BEGIN

  { if the device is still open, return error }
  If (WaveDeviceOpen) Then
    Begin
      ErrorMessage := 'Wave output device is already open';
      Result := FALSE;
      Exit;
    End;

  BufIndex := 0;

  { Now create the window component to handle the processing }
  CallBackWin := TCallBackWinOut.CreateParented(TWinControl(Owner).Handle);
  CallBackWin.Visible := FALSE;
  CallBackWin.AudioComponent := @TS;

  { Open the device for playout }
  { Either go via interrupt or window }
  iErr := WaveOutOpen(@WaveHandle, FWaveDevice, @FWaveFmtEx, Integer(CallBackWin.Handle),
                      0, CALLBACK_WINDOW or WAVE_ALLOWSYNC );

  If (iErr <> 0) Then
    Begin
      ErrorMessage := TWaveOutGetErrorText(iErr);
      Result := FALSE;
      Exit;
    End;

  WaveDeviceOpen := TRUE;

  { Setup the buffers and headers }
  If (Not InitWaveHeaders) Then
    Begin
      Result := FALSE;
      Exit;
    End;

  { Now Prepare the buffers for output }
  For i := 0 to FNumBuffers-1 Do
    Begin
      iErr := WaveOutPrepareHeader(WaveHandle, WaveHdr[i], sizeof(TWAVEHDR));
      If (iErr <> 0) Then
        Begin
          ErrorMessage := TWaveOutGetErrorText(iErr);
          CloseWaveDevice;
          Result := FALSE;
          Exit;
        End;
    End;

  { Read in the buffers }
  QueuedBuffers := 0;
  ProcessedBuffers := 0;
  FilledBuffers := 0;
  ContinueProcessing := TRUE;
  Active := TRUE;

  If (Not ReadBuffer(0, FBufferSize)) Then
    Begin
      CloseWaveDevice;
      ErrorMessage := 'There must be at least one filled buffer';
      Result := FALSE;
      Exit;
    End;

  For i := 1 to FNumBuffers - 1 Do ReadBuffer(i, FBufferSize);

  Result := TRUE;
END;

{----------------QueueBuffer----------------John Mertus---14-June--97--}

   Function TAudioOut.QueueBuffer : Boolean;

{ Write the buffer to the wave device and toggel buffer index.          }
{									}
{**********************************************************************}
Var
  iErr : Integer;

BEGIN
 { reset flags field (remove WHDR_DONE attribute) }
  WaveHdr[bufindex].dwFlags := WHDR_PREPARED;

 { now queue the buffer for output }
  iErr := waveOutWrite( WaveHandle, WaveHdr[bufindex], sizeof(TWAVEHDR));
  If (iErr <> 0) Then
    Begin
      ErrorMessage := TwaveOutGetErrorText(iErr);
      StopGracefully;
      Result := FALSE;
      Exit;
    End;

  { Advance index }
  bufindex := (bufindex+1) mod FNumBuffers;

  Result := TRUE;
END;

{-------------StartIt------------------------John Mertus---14-June--97--}

   Function TAudioOut.StartIt : Boolean;

{ This function just starts the waveform playing                        }
{									}
{**********************************************************************}
Var
  i : Integer;

BEGIN
  Active := TRUE;

  If (FPaused) Then WaveOutPause(WaveHandle);
  { Now we are ready to start the output }
  If (Not QueueBuffer) Then
    Begin
      CloseWaveDevice;
      Result := FALSE;
      Exit;
    End;

  For i := 0 to FNumBuffers - 2 Do QueueBuffer;
  Result := TRUE;
END;

{-----------------Start----------------------John Mertus---14-June--97--}

   Function TAudioOut.Start(Var TS : TAudioOut) : Boolean;

{ This function first sets up the output and then starts it.            }
{									}
{**********************************************************************}
BEGIN
  Result := Setup(TS);
  If (Not Result) Then Exit;

  Result := StartIt;
  If (Not Result) Then Exit;
END;


{-------------ReadBuffer---------------------John Mertus---14-June--97--}

   Function  TAudioOut.ReadBuffer(Idx, N : Integer) : Boolean;

{ This is called whenver move buffer data is needed.                    }
{									}
{**********************************************************************}
Var
  NSize : Integer;

BEGIN
  { Do not call the read buffer routine if we want to stop }