soundin.pas

灰鸽子VIP1.2经典源代码

unit soundin;
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: ACMIn.pas, released August 28, 2000.

The Initial Developer of the Original Code is Peter Morris ([e-mail]),
Portions created by Peter Morris are Copyright (C) 2000 Peter Morris.
All Rights Reserved.

Purpose of file:
Allows you to open an audio-input stream, in almost any format

Contributor(s):
None as yet


Last Modified: September 14, 2000
Current Version: 1.10

You may retrieve the latest version of this file at http://www.stuckindoors.com/dib

Known Issues:
TrueSpeech doesn't work for some reason.
-----------------------------------------------------------------------------}

//November 2nd, 2000
//Pete M
//I was stupidly freeing the wav header data before calling an event, this
//caused intermittent Access Violations.  This is now fixed.

//adapted and changed to build good voip component by remko weingarten


//[e-mail]    date october 2002



interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  soundconverter, MMSystem, headers;

type
  TACMBufferCount = 2..64;
    PMixDetails = ^TMixDetails;
    TMixDetails = record
                 Destination,Source : Word;
                 Name : string;
                 VolControlID,MuteControlID, MeterControlID : dword;
                 Left, Right, Meter : Word;
                 CtrlType : Word;
                 Mute, Mono, Speakers, Available : boolean;
                 Next:PMixDetails;
                end;

  TBufferFullEvent = procedure(Sender : TObject; Data : Pointer; Size:longint) of object;
  EACMIn = Class(Exception);
  TACMIn = class(TComponent)


  private
    FActive                   : Boolean;
    FBufferList               : TList;
    FBufferSize               : DWord;
    FFormat                   : TACMWaveFormat;
    FNumBuffers               : TACMBufferCount;
    FWindowHandle             : HWnd;
    FOnBufferFull             : TBufferFullEvent;
    procedure DoBufferFull(Header : PWaveHdr);
    procedure SetBufferSize(const Value: DWord);
    procedure SetNumBuffers(const Value: TACMBufferCount);

  protected
    function  NewHeader : PWaveHDR;
    procedure DisposeHeader(Header : PWaveHDR);
    procedure WndProc(Var Message : TMessage);
  public
      FWaveInHandle             : HWaveIn;
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure Open(aFormat : TACMWaveFormat);
    procedure Close;
    procedure RaiseException(const aMessage : String; Result : Integer);
     property Active         : Boolean
        read FActive;
      property WindowHandle   : HWnd
        read FWindowHandle;
    published
      property BufferSize     : DWord
        read FBufferSize
        write SetBufferSize;
      property NumBuffers     : TACMBufferCount
        read FNumBuffers
        write SetNumBuffers;

      property OnBufferFull   : TBufferFullEvent
        read FOnBufferFull
        write FOnBufferFull;
 end;


implementation


constructor TACMIn.Create(AOwner:TComponent);
begin
 inherited;
 FBufferList := TList.Create;
 FActive := False;
 FBufferSize := 8192;
 FWaveInHandle := 0;
 FWindowHandle := AllocateHWND(WndProc);
 FNumBuffers := 4;
end;

procedure TACMIn.DoBufferFull(Header : PWaveHdr);
var
   Res                        : Integer;
   BytesRecorded              : Integer;
   Data                       : Pointer;
begin
  if Active then begin

    BytesRecorded:=header.dwBytesRecorded;

    if assigned(FOnBufferFull) then begin
      Getmem(Data, BytesRecorded);
      try
        move(header.lpData^,Data^,BytesRecorded);
        FOnBufferFull(Self, data, BytesRecorded); 
      finally
        Freemem(Data);
      end;
    end;

    Res := WaveInUnPrepareHeader(FWaveInHandle,Header,sizeof(TWavehdr));
    if Res <>0  then RaiseException('WaveIn-UnprepareHeader', Res);

    header.dwbufferlength:=FBufferSize;
    header.dwBytesRecorded:=0;
    header.dwUser:=0;
    header.dwflags:=0;
    header.dwloops:=0;
    FillMemory(Header.lpData,FBufferSize,0); //snap het nut er niet van...

    Res := WaveInPrepareHeader(FWaveInHandle,Header,sizeof(TWavehdr));
    if Res <> 0 then RaiseException('WaveIn-PrepareHeader', Res);

    Res:=WaveInAddBuffer(FWaveInHandle,Header,sizeof(TWaveHdr));
    if Res <> 0 then RaiseException('WaveInAddBuffer', Res);


   end else
    if not (csDestroying in ComponentState) then
      DisposeHeader(Header);

end;

procedure TACMIn.Open(aFormat : TACMWaveFormat);
var
  Res                         : Integer;
  J                           : Integer;
  Device                      : Integer;
  Params                      : Integer;
begin
  if Active then exit;
  FWaveInHandle := 0;
  FFormat := aFormat;


  if FFormat.Format.wFormatTag = 1 then begin
    Params := CALLBACK_WINDOW;
    Device := -1;
  end else begin
    Params := CALLBACK_WINDOW or WAVE_MAPPED;
    Device := 0;
  end;
if aformat.format.wFormatTag=1 then
  Res := WaveInOpen(@FWaveInHandle,Device,@aFormat.Format,FWindowHandle,0,CALLBACK_WINDOW ) else
Res := WaveInOpen(@FWaveInHandle,Device,@aFormat.Format,FWindowHandle,0,CALLBACK_WINDOW or WAVE_MAPPED);
  if Res <> 0 then RaiseException('WaveIn-Open',Res);

  for j:= 1 to FNumBuffers do NewHeader;

  Res := WaveInStart(FWaveInHandle);
  if Res <> 0 then RaiseException('WaveIn-Start',Res);

  FActive := True;
end;

destructor TACMIn.Destroy;
begin
  if Active then Close;
  FBufferList.Free;
  DeAllocateHWND(FWindowHandle);
  inherited;
end;

procedure TACMIn.RaiseException(const aMessage: String; Result: Integer);
begin
try
if factive then close;
except
end;
  case Result of
    ACMERR_NotPossible : Raise EACMIn.Create(aMessage + ' The requested operation cannot be performed.');
    ACMERR_BUSY : Raise EACMIn.Create(aMessage + ' The conversion stream is already in use.');
    ACMERR_UNPREPARED : Raise EACMIn.Create(aMessage + ' Cannot perform this action on a header that has not been prepared.');
    MMSYSERR_InvalFlag : Raise EACMIn.Create(aMessage + ' At least one flag is invalid.');
    MMSYSERR_InvalHandle : Raise EACMIn.Create(aMessage + ' The specified handle is invalid.');
    MMSYSERR_InvalParam : Raise EACMIn.Create(aMessage + ' At least one parameter is invalid.');
    MMSYSERR_NoMem : Raise EACMIn.Create(aMessage + ' The system is unable to allocate resources.');
    MMSYSERR_NoDriver : Raise EACMIn.Create(aMessage + ' A suitable driver is not available to provide valid format selections.');
    MMSYSERR_ALLOCATED : Raise EACMIn.Create(aMessage + ' The specified resource is already in use.');
    MMSYSERR_BADDEVICEID : Raise EACMIn.Create(aMessage + ' The specified resource does not exist.');
    WAVERR_BADFORMAT : Raise EACMIn.Create(aMessage + ' Unsupported audio format.');
    WAVERR_SYNC : Raise EACMIn.Create(aMessage + ' The specified device does not support asynchronous operation.');
  else
    if Result <> 0 then
      Raise EACMIn.Create(SysUtils.Format('%s raised an unknown error (code #%d)',[aMessage,Result]));
  end;

end;

procedure TACMIn.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    MM_WIM_Data: DoBufferFull(PWaveHDR(Message.LParam));
  end;
inherited
end;


procedure TACMIn.Close;
var
  X                           : Integer;
begin
  if not Active then Exit;
  FActive := False;
  WaveInReset(FWaveInHandle);
  WaveInClose(FWaveInHandle);
  FWaveInHandle := 0;
  For X:=FBufferList.Count-1 downto 0 do DisposeHeader(PWaveHDR(FBufferList[X]));
end;

procedure TACMIn.SetBufferSize(const Value: DWord);
begin
  if Active then exit;
  FBufferSize := Value;
end;

function TACMIn.NewHeader: PWaveHDR;
var
  Res                         : Integer;
begin
  Getmem(Result, SizeOf(TWaveHDR));
  FBufferList.Add(Result);
  with Result^ do begin
    Getmem(lpData,FBufferSize);
    dwBufferLength := FBufferSize;
    dwBytesRecorded := 0;
    dwFlags := 0;
    dwLoops := 0;
    Res := WaveInPrepareHeader(FWaveInHandle,Result,sizeof(TWaveHDR));
    if Res <> 0 then RaiseException('WaveIn-PrepareHeader',Res);

    Res := WaveInAddBuffer(FWaveInHandle,Result,SizeOf(TWaveHDR));
    if Res <> 0 then RaiseException('WaveIn-AddBuffer',Res);
  end;
end;

procedure TACMIn.SetNumBuffers(const Value: TACMBufferCount);
begin
  if Active then exit;
  FNumBuffers := Value;
end;

procedure TACMIn.DisposeHeader(Header: PWaveHDR);
var
  X                           : Integer;
begin
  X := FBufferList.IndexOf(Header);
  if X < 0 then exit;
  Freemem(header.lpData);
  Freemem(header);
  FBufferList.Delete(X);
end;

end.