{ACMIO v1.0

                            EMail: gqg@21cn.com
                            Http:  pcauto.3322.net
}
unit ACMOut;
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ACMConvertor, MMSystem, MSACM;

type
  EACMOut = class(Exception);
  TBufferPlayedEvent = procedure(Sender : TObject; Header : PWaveHDR) of object;
  TACMOut = class(TComponent)
  private
    { Private declarations }
    FActive                   : Boolean;
    FNumBuffersLeft           : Byte;
    FBackBufferList           : TList;
    FNumBuffers               : Byte;
    FBufferList               : TList;
    FFormat                   : TACMWaveFormat;
    FOnBufferPlayed           : TBufferPlayedEvent;
    FWaveOutHandle            : HWaveOut;
    FWindowHandle             : HWnd;
    function GetBufferCount: Integer;
  protected
    { Protected declarations }
    function  NewHeader : PWaveHDR;
    procedure DisposeHeader(Header : PWaveHDR);
    procedure DoWaveDone(Header : PWaveHdr);
    procedure WndProc(var Message : TMessage);
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;

    procedure Close;
    procedure Open(aFormat : TACMWaveFormat);
    procedure Play(Buffer:pointer; Size : Integer);
    procedure RaiseException(const aMessage : String; Result : Integer);

    property Active           : Boolean
      read FActive;
    property BufferCount      : Integer
      read GetBufferCount;
    property Format           : TACMWaveFormat
      read FFormat;
    property WindowHandle     : HWnd
      read FWindowHandle;

  published
    { Published declarations }
    property NumBuffers      : Byte
      read FNumBuffers
      write FNumBuffers;
    property OnBufferPlayed   : TBufferPlayedEvent
      read FOnBufferPlayed
      write FOnBufferPlayed;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('ACM IO', [TACMOut]);
end;



procedure TACMOut.Close;
var
  X                           : Integer;
begin
  if not Active then exit;
  FActive := False;
  WaveOutReset(FWaveOutHandle);
  WaveOutClose(FWaveOutHandle);
  FBackBufferList.Clear;
  FWaveOutHandle := 0;
  For X:=FBufferList.Count-1 downto 0 do DisposeHeader(PWaveHDR(FBufferList[X]));
end;

constructor TACMOut.Create(AOwner: TComponent);
begin
  inherited;
  FBufferList := TList.Create;
  FBackBufferList := TList.Create;
  FActive := False;
  FWindowHandle := AllocateHWND(WndProc);
  FWaveOutHandle := 0;
  FNumBuffers := 4;

end;

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

procedure TACMOut.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;

procedure TACMOut.DoWaveDone(Header : PWaveHdr);
var
  Res                         : Integer;
begin
  if not Active then exit;
  if Assigned(FOnBufferPlayed) then FOnBufferPlayed(Self, Header);
  Res := WaveOutUnPrepareHeader(FWaveOutHandle, Header, SizeOf(TWaveHDR));
  if Res <> 0 then RaiseException('WaveOut-UnprepareHeader',Res);
  DisposeHeader(Header);
end;

function TACMOut.GetBufferCount: Integer;
begin
  Result := FBufferList.Count;
end;

function TACMOut.NewHeader: PWaveHDR;
begin
  GetMem(Result, SizeOf(TWaveHDR));
  FBufferList.Add(Result);
end;

procedure TACMOut.Open(aFormat: TACMWaveFormat);
var
  Res                         : Integer;
  Device                      : Integer;
  Params                      : Integer;
begin
  if Active then exit;
  FWaveOutHandle := 0;
  FNumBuffersLeft := FNumBuffers;
  FFormat := aFormat;


    Params := CALLBACK_WINDOW;
    Device := -1;

  Res := WaveOutOpen(@FWaveOutHandle,Device,@FFormat.Format,FWindowHandle,0, params);
  if Res <> 0 then RaiseException('WaveOutOpen',Res);
  FActive := True;
end;

procedure TACMOut.Play(Buffer:pointer; Size: Integer);
var
  TempHeader                  : PWaveHdr;
  Data                        : Pointer;
  Res                         : Integer;
  X                           : Integer;

  procedure PlayHeader(Header : PWaveHDR);
  begin
    Res := WaveOutPrepareHeader(FWaveOutHandle,Header,SizeOf(TWaveHDR));
    if Res <> 0 then RaiseException('WaveOut-PrepareHeader',Res);

    Res := WaveOutWrite(FWaveOutHandle, Header, SizeOf(TWaveHDR));
    if Res <> 0 then RaiseException('WaveOut-Write',Res);
  end;

begin
  if Size = 0 then exit;
  if not active then exit;
  TempHeader := NewHeader;
  GetMem(Data, Size);
  Move(Buffer^,Data^,Size);
  with TempHeader^ do begin
    lpData := Data;
    dwBufferLength := Size;
    dwBytesRecorded :=0; //Was " := Size;" but not needed, and crashes some PC's
    dwUser := 0;
    dwFlags := 0;
    dwLoops := 1;
  end;

  if FNumBuffersLeft > 0 then begin
    FBackBufferList.Add(TempHeader);
    Dec(FNumBuffersLeft);
  end else begin
    for X:=0 to FBackBufferList.Count-1 do
      PlayHeader(PWaveHDR(FBackBufferList[X]));
    FBackBufferList.Clear;
    PlayHeader(TempHeader);
  end;
end;

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

end;

procedure TACMOut.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    MM_WOM_DONE : DoWaveDone(PWaveHDR(Message.LParam));
  end;
end;

end.