{*************************************************************************
  Unit:                Audio.pas

  Description:         TAudio component for accessing waveform devices

  Accessed Units:      mmSystem.pas

  Compiler:            Delphi 1.02 (16 bit) and Delphi 3 (32 bit)

  I/O:                 waveform device via Windows multimedia API

  References           - mmSystem.hlp (Win16) and mm.hlp (Win32)
                       - UDDF, Nov 1997 article "Low Level WaveIn Routine" by John Mertus
                       - UNDU, Sept 1997 article "Playing and Recording Sound in Delphi" by Darryl Gove
                       - Delphi Bug List, waveInClose error in mmSystem by Reinier Sterkenburg
                       - TJW's web site, "The Wave File Format" by Timothy J Weber
                       - Colin's web site, Mixer Control by Colin Wilson

  Conditions of usage  Freeware, use at own risk. Please report faults or comments to the author

  Author               Mr Hakan Bergzen, hakan_bergzen@hotmail.com

  Ver   Date    Made by              Change

  1.0   980106  Hakan Bergzen (HBn)  Basic version for Win16
  1.0   980117  HBn                  Converted for Win32
  2.0   980412  HBn                  Added wave file support
  3.0   980702  HBn                  Corrected errors, reworked structure and
                                     added functions
  3.0   980716  HBn                  Added Mixer Control capability (32bit only)
  3.1   980725  HBn                  Added wave_mapper, changed PlayFile procedure
                                     and changed Mixer procedures
  3.2   980823  HBn                  Extended RecordToFile functionality,
                                     corrected errors
  3.3x  9809xx-9811xx  HBn           Non-released test versions
  4.0   981122  HBn                  Fixed consecutive playing of files,
                                           stop while playing,
                                           callback_function under WindowsNT,
                                     modified PlayFile for various wav file formats,
                                              Mixer functions internally,
                                     added Meter reading,
                                           OnMixerChange event,
                                           Mixer status in Query,
                                     faster start-up time in Play when using Left and Right TStreams,
                                            TrigLevel and Split (in assembler),
                                     less RAM required (PlayStream changed from
                                                        MemoryStream to FileStream),
                                     fewer user instructions (no more need to use Open
                                                        and Close from the application)
  4.1   990322  HBn                  Removed faults causing Delphi/Windows to crash
                                     in some installations
**************************************************************************}

Unit Audio;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Forms, Classes,
  mmSystem;

type
   TChannels = (Mono, Stereo);
   TBPS = (_8,_16);

const
   DefaultAudioDeviceID = WAVE_MAPPER;
   No_Buffers = 4;
   ChannelsDefault = Mono;
   BPSDefault = _8;
   SPSDefault = 11025;
   NoSamplesDefault = 8192;

{$IFDEF WIN32}
   DefaultMixerDeviceID = 0;
   Ver = '4.1 (32bit)';
{$ELSE}
   Ver = '4.1 (16bit)';
{$ENDIF}

type
  TNotifyAudioRecordEvent = procedure(Sender: TObject; LP,RP: Pointer; BufferSize: Word) of object;
  TNotifyBufferPlayedEvent = procedure(Sender: TObject) of object;
  TNotifyPlayedEvent = procedure(Sender: TObject) of object;
{$IFDEF WIN32}
  TNotifyMixerChange = procedure(Sender:TObject;Destination,Source: Word) of object;
{$ENDIF}

  TAudio = class;

{$IFDEF WIN32}
  ValuesArray = array [0..1] of integer;
  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;

  TMixerSettings = class(TPersistent)
  private
    FAudio              : TAudio;
    MixerHandle         : HMIXER;
    MixerStart          : PMixDetails;
    MixerReady          : boolean;
    MixerCallbackHandle : HWND;
    FList               : TStrings;
    procedure InitiateControlDetails(var details:TMixerControlDetails;
              ControlID,Channels:dword; pvalues:pointer);
    function GetMixerSettings(MixerDeviceID:integer):boolean;
    procedure MixerCallBack(var Msg:TMessage);
  public
    function GetName(Dest,Source:Word):string;
    function SetControl(Dest,Source:Word; LeftVolume,RightVolume:Word; Mute:boolean):boolean;
    function GetControl(Dest,Source:Word; var LeftVolume,RightVolume:Word; var Mute:boolean; var CtrlType:byte):boolean;
    function GetMeter(Dest,Source:Word; var LeftVolume,RightVolume:dword):boolean;
    function GetSources(Dest:Word):TStrings;
    function GetDestinations:TStrings;
    function Query(var Product,Formats:string):boolean;
  end;
{$ENDIF}

  TAudioSettings = class(TPersistent)
  private
    FAudio               : TAudio;
    pWaveHeader          : array [0..No_Buffers-1] of PWAVEHDR;
    pWaveBuffer          : array [0..No_Buffers-1] of pointer;
    pExtraBuffer         : array [0..No_Buffers-1] of pointer;  {Used to carry Right samples during Split channels}
    ForwardIndex         : Integer;
    ReturnIndex          : Integer;
    ActiveBuffers        : Integer;
    DeviceOpen           : Boolean;
  private
    FChannels            : TChannels;
    FBPS                 : TBPS;
    FSPS                 : Word;
    FNoSamples           : Word;
{$IFDEF WIN32}
    pWaveFmt             : pWaveFormatEx;
{$ELSE}
    pWaveFmt             : pPCMWaveFormat;
{$ENDIF}
    WaveBufSize          : Word;
    procedure SetChannels(Value:TChannels);
    procedure SetBPS(Value:TBPS);
    procedure SetSPS(Value:Word);
    procedure InitWaveHeaders;
    function AllocateMemory: Boolean;
    procedure FreeMemory;
  public
    Active               : Boolean;
  published
    property BitsPerSample: TBPS read FBPS write SetBPS default BPSDefault;
    property Channels: TChannels read FChannels write SetChannels default ChannelsDefault;
    property SampleRate: Word read FSPS write SetSPS default SPSDefault;
  end;

  PRecorder = ^TRecorder;
  TRecorder = class(TAudioSettings)
  private
    WaveIn                   : HWAVEIN;
    FPause                   : Boolean;
    FSplit                   : Boolean;
    FTrigLevel               : Word;
    FTriggered               : Boolean;
    RecStream                : TFileStream;
    RecToFile                : Boolean;
    AddNextInBufferHandle    : hWnd;
    procedure AddNextInBuffer2(var Msg: TMessage);
    function AddNextInBuffer: Boolean;
    procedure SetTrigLevel(Value:Word);
    function TestTrigger(StartPtr:pointer; Size:Word):boolean;
    procedure SetSplit(Value:Boolean);
    procedure Split(var LP,RP:pointer; var Size:Word);
    procedure GetError(iErr : Integer; Additional:string);
    procedure SetNoSamples(Value:Word);
    function  Open : boolean;
    function Close : boolean;
  public
    function  Start : boolean;
    function Stop : boolean;
    procedure Pause;
    procedure Restart;
    procedure RecordToFile(FileName:string; LP,RP:TStream);
  published
    property NoSamples: Word read FNoSamples write SetNoSamples default NoSamplesDefault;
    property SplitChannels: Boolean read FSplit write SetSplit default false;
    property TrigLevel: Word read FTrigLevel write SetTrigLevel default 128;
    property Triggered: Boolean read FTriggered write FTriggered default true;
  end;

  PPlayer = ^TPlayer;
  TPlayer = class(TAudioSettings)
  private
    WaveOut                : HWAVEIN;
    FNoOfRepeats           : Word;
    ReadPlayStreamPos      : LongInt;
    PlayStream             : TFileStream;
    FPlayFile              : boolean;
    PlayFileStream         : TFileStream;
    FOldChannels            : TChannels;
    FOldBPS                 : TBPS;
    FOldSPS                 : Word;
    FinishedPlaying         : boolean;
    AddNextOutBufferHandle  : hWnd;
    CloseHandle             : hWnd;
    procedure AddNextOutBuffer2(var Msg: TMessage);
    procedure Close2(var Msg: TMessage);
    function  Open : boolean;
    procedure GetError(iErr : Integer; Additional:string);
    function AddNextOutBuffer:longint;
  public
    procedure SetVolume(LeftVolume,RightVolume:Word);
    procedure GetVolume(var LeftVolume,RightVolume:Word);
    procedure Play(LP,RP:TStream; NoOfRepeats:Word);
    procedure Stop;
    procedure Pause;
    procedure Reset;
    procedure Restart;
    procedure BreakLoop;
    function PlayFile(FileName:string; NoOfRepeats:Word):boolean;
  published
  end;

  TAudio = class(TComponent)
  private
    FVersion             : string;
    FDeviceID            : Integer;
    FSepCtrl             : Boolean;
    procedure SetDeviceID(Value:Integer);
    procedure SetVersion(Value:string);
  private
    FOnAudioRecord       : TNotifyAudioRecordEvent;
    FRecorder            : TRecorder;
  private
    FOnBufferPlayed      : TNotifyBufferPlayedEvent;
    FOnPlayed            : TNotifyPlayedEvent;
    FPlayer              : TPlayer;
  private
    FWindowHandle        : HWND;
    WaveFmtSize          : Integer;
{$IFDEF WIN32}
    FMixerDeviceID       : Integer;
    FOnMixerChange       : TNotifyMixerChange;
    procedure SetMixerDeviceID(Value:Integer);
{$ENDIF}
    procedure AudioCallBack(var Msg: TMessage);export;
   public
{$IFDEF WIN32}
    Mixer                : TMixerSettings;
{$ENDIF}
    ErrorMessage         : string;
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    function Query(var Product,Formats:string):boolean;
  published
    property AudioDeviceID: Integer read FDeviceID write SetDeviceID default DefaultAudioDeviceID;
{$IFDEF WIN32}
    property MixerDeviceID: Integer read FMixerDeviceID write SetMixerDeviceID default DefaultMixerDeviceID;
{$ENDIF}
    property SeparateCtrls: Boolean read FSepCtrl write FSepCtrl default false;
    property Player: TPlayer read FPlayer write FPlayer;
    property Recorder: TRecorder read FRecorder write FRecorder;
    property Version: string read FVersion write SetVersion;

    property OnRecord: TNotifyAudioRecordEvent read FOnAudioRecord write FOnAudioRecord;
    property OnBufferPlayed: TNotifyBufferPlayedEvent read FOnBufferPlayed write FOnBufferPlayed;
    property OnPlayed: TNotifyPlayedEvent read FOnPlayed write FOnPlayed;
{$IFDEF WIN32}
    property OnMixerChange:TNotifyMixerChange read FOnMixerChange write FOnMixerChange;
{$ENDIF}
  end;
{$IFDEF WIN32}
{$ELSE}
  function CorrectedwaveInClose(hWaveIn: HWaveIn): Word;
{$ENDIF}

  procedure Register;

implementation

{$IFDEF WIN32}
{$ELSE}
function CorrectedwaveInClose; external 'MMSYSTEM' index 505;
{$ENDIF}
{------------- WinAPI CallBack routines --------------------------------}
{ Callback routine used for CALLBACK_WINDOW in waveInOpen and waveOutOpen    }
procedure TAudio.AudioCallBack(var Msg: TMessage);
var LP,RP:pointer;
    Size:Word;
begin
  case Msg.Msg of
    mm_wim_OPEN  : FRecorder.Active:=true;
    mm_wim_CLOSE : FRecorder.Active:=false;
    mm_wim_DATA  : begin
                     if FRecorder.Active then begin
                       LP:=FRecorder.pWaveBuffer[FRecorder.ReturnIndex Mod No_Buffers];
                       RP:=FRecorder.pExtraBuffer[FRecorder.ReturnIndex Mod No_Buffers];
                       Size:=FRecorder.pWaveHeader[FRecorder.ReturnIndex Mod No_Buffers]^.dwBytesRecorded;
                       if (not(FRecorder.FPause) and FRecorder.TestTrigger(LP,Size)) then begin
                              if FRecorder.RecToFile then FRecorder.RecStream.write(LP^,Size);
                              if Assigned(FOnAudioRecord) then begin
                                if FRecorder.FSplit then begin
                                  FRecorder.Split(LP,RP,Size);
                                  FOnAudioRecord(Self,LP,RP,Size);
                                end else FOnAudioRecord(Self,LP,nil,Size);
                              end;
                       end;
                       if (Size>0) then begin
                            PostMessage(FRecorder.AddNextInBufferHandle,wim_DATA,0,0);
   {                         FRecorder.AddNextInBuffer;       }
                            FRecorder.ReturnIndex:=(FRecorder.ReturnIndex+1) mod No_Buffers;
                       end;
                     end;
                   end;
    mm_wom_OPEN  : FPlayer.Active:=true;
    mm_wom_CLOSE : FPlayer.Active:=false;
    mm_wom_DONE  : if FPlayer.Active then begin
                     if (FPlayer.ForwardIndex=FPlayer.ReturnIndex) then begin
                       if not(FPlayer.FinishedPlaying) then begin
                         FPlayer.FinishedPlaying:=true;
                         PostMessage(FPlayer.CloseHandle,mm_wom_CLOSE,0,0);
                       end;
                     end else begin
                       if Assigned(FOnBufferPlayed) then FOnBufferPlayed(Self);
                       PostMessage(FPlayer.AddNextOutBufferHandle,wom_DONE,0,0);
                       FPlayer.ReturnIndex:=(FPlayer.ReturnIndex+1) mod No_Buffers;
                       dec(FPlayer.ActiveBuffers);
                     end;
                   end;
    wm_QueryEndSession : Destroy;    { only called if Callback_Window is used }
  end;
end;
{------------- Internal/Private routines -------------------------------}

procedure TAudioSettings.InitWaveHeaders;
var
  i : Integer;
begin
  for i:=0 to No_Buffers-1 do begin
    pWaveHeader[i]^.lpData:=pWaveBuffer[i];
    pWaveHeader[i]^.dwBufferLength:=WaveBufSize;
    pWaveHeader[i]^.dwBytesRecorded:=0;
    pWaveHeader[i]^.dwUser:=0;
    pWaveHeader[i]^.dwFlags:=0;
    pWaveHeader[i]^.dwLoops:=0;
    pWaveHeader[i]^.lpNext:=nil;
    pWaveHeader[i]^.reserved:=0;
  end;
end;

function TAudioSettings.AllocateMemory: Boolean;
var
  i : Integer;
begin
    pWaveFmt:=nil;
    try
      GetMem(pWaveFmt,FAudio.WaveFmtSize);
    except
      FAudio.ErrorMessage:='Not enough memory to allocate WaveFormat';
      Result:=false;
      Exit;
    end;
    if FBPS=_8 then pWaveFmt^.wBitsPerSample :=8
    else pWaveFmt^.wBitsPerSample :=16;
{$IFDEF WIN32}
    pWaveFmt^.cbSize:=0;
    with pWaveFmt^ do begin
{$ELSE}
    with pWaveFmt^.wf do begin
{$ENDIF}
      wFormatTag:=WAVE_FORMAT_PCM;
      if FChannels=Mono then nChannels:=1
      else nChannels:=2;
      nSamplesPerSec:=FSPS;
{ BlockAlign : e.g. 16-bit stereo PCM => 4 = 2 channels x 2 bytes/channel    }
      if FBPS=_8 then nBlockAlign:=(8 div 8)*nChannels
      else nBlockAlign:=(16 div 8)*nChannels;
      nAvgBytesPerSec:=nSamplesPerSec*nBlockAlign;
      WaveBufSize:=FNoSamples*nBlockAlign;
    end;

    for i:=0 to No_Buffers-1 do begin
      pWaveHeader[i]:=nil;
      try
        GetMem(pWaveHeader[i],sizeof(TWAVEHDR));
      except
        FAudio.ErrorMessage:='Not enough memory to allocate WaveHeader';
        Result:=false;
        Exit;
      end;
      pWaveBuffer[i]:=nil;
      pExtraBuffer[i]:=nil;
      try
        GetMem(pWaveBuffer[i],WaveBufSize);
        GetMem(pExtraBuffer[i],(WaveBufSize div 2));
      except
        FAudio.ErrorMessage:='Not enough memory to allocate Wave Buffer';
        Result:=false;
        Exit;
      end;
      pWaveHeader[i]^.lpData:=pWaveBuffer[i];
    end;
    Result:=true;
end;

procedure TAudioSettings.FreeMemory;
var
  i : Integer;
begin
  if (pWaveFmt = nil) then Exit
  else begin
    FreeMem(pWaveFmt,FAudio.WaveFmtSize);
    pWaveFmt:=nil;
  end;
  for i:=0 to No_Buffers-1 do begin
    if (pWaveBuffer[i]<>nil) then FreeMem(pWaveBuffer[i],WaveBufSize);
    pWaveBuffer[i]:=nil;
    if (pExtraBuffer[i]<>nil) then FreeMem(pExtraBuffer[i],(WaveBufSize div 2));
    pExtraBuffer[i]:=nil;
    if (pWaveHeader[i]<>nil) then FreeMem(pWaveHeader[i],sizeof(TWAVEHDR));
    pWaveHeader[i]:=nil;
  end;
end;

function TRecorder.TestTrigger(StartPtr:pointer; Size:Word):boolean;
var
{$IFDEF WIN32}
    i : longint;
    j :boolean;
    k : Word;
{$ELSE}
    BytesCounted : Word;
    pb : ^byte;
    ip : ^smallint;
{$ENDIF}
begin
{$IFDEF WIN32}
  if not(FTriggered) and (Size>0) then begin
    j:=FTriggered;
    i:=Size;
    k:=FTrigLevel;
    if FBPS=_8 then begin
asm
    mov eax,StartPtr
    mov ecx,i
    mov edx,0
@trig8:
    mov dl,[eax]
    cmp dx,k
    jge @out8
    add eax,1
    pop ecx
    loop @trig8
    jmp @out88
@out8:
    mov j,1
@out88:
end;
    end else begin
asm
    mov eax,StartPtr
    mov ecx,i
    shr ecx,1
    mov edx,0
@trig16:
    mov dx,[eax]
    cmp dx,k
    jge @out16
    add eax,2
    loop @trig16
    jmp @out16a
@out16:
    mov j,1
@out16a:
end;
    end;
    FTriggered:=j;
  end;
{$ELSE}
  if not(FTriggered) and (Size>0) then begin
    if FBPS=_8 then begin
      pb:=StartPtr;
      repeat
         if pb^>TrigLevel then FTriggered:=true;
         inc(pb);
         inc(BytesCounted);
      until (BytesCounted>=Size) or FTriggered;
    end else begin
      ip:=StartPtr;
      repeat
         if ip^>TrigLevel then FTriggered:=true;
         inc(ip);
         inc(BytesCounted,2);
      until (BytesCounted>=Size) or FTriggered;
    end;
  end;
{$ENDIF}
  Result:=FTriggered;
end;

procedure TRecorder.Split(var LP,RP:pointer; var Size:Word);
var
    i : longint;
    lb,rb,pb : ^byte;
begin
 if (Size>0) then begin
  Size:=Size div 2;
  lb:=LP; rb:=RP;
  pb:=LP;
{$IFDEF WIN32}
  i:=Size;
  if FBPS=_8 then begin
asm
    mov eax,lb
    mov ecx,i
    mov edx,rb
@split8:
    push ecx
    mov ecx,pb
    mov cx,[ecx]
    mov [eax],cl
    mov [edx],ch
    add dword ptr [pb],2
    add eax,1
    add edx,1
    pop ecx
    loop @split8
end;
  end else begin
asm
    mov eax,lb
    mov ecx,i
    shr ecx,1
    mov edx,rb
@split16:
    push ecx
    mov ecx,pb
    mov ecx,[ecx]
    mov [eax],cx
    shr ecx,16
    mov [edx],cx
    add dword ptr [pb],4
    add eax,2
    add edx,2
    pop ecx
    loop @split16
end;
  end;
{$ELSE}
{ The lines below are replaced with the asm routine above
  starting from (and including) i:=Size       }
  if FBPS=_8 then begin
    for i:=1 to Size do begin
       lb^:=pb^; inc(lb);inc(pb);
       rb^:=pb^; inc(rb);inc(pb);
    end;
  end else begin
    for i:=1 to (Size div 2) do begin
       lb^:=pb^; inc(lb);inc(pb);
       lb^:=pb^; inc(lb);inc(pb);
       rb^:=pb^; inc(rb);inc(pb);
       rb^:=pb^; inc(rb);inc(pb);
    end;
  end;
{$ENDIF}
 end;
end;

procedure TRecorder.AddNextInBuffer2(var Msg: TMessage);
begin
   if (Msg.Msg=wim_DATA) and DeviceOpen then AddNextInBuffer;
end;

function TRecorder.AddNextInBuffer: Boolean;
var
  iErr : Integer;
begin
   iErr:=waveInAddBuffer(WaveIn, pwaveheader[ForwardIndex], sizeof(TWAVEHDR));
   if (iErr<>0) then begin
       Stop;
       GetError(iErr,'Error adding input buffer');
       Result:=false;
       Exit;
   end;
   ForwardIndex:=(ForwardIndex+1) mod No_Buffers;
   Result:=true;
end;

procedure TRecorder.GetError(iErr : Integer; Additional:string);
var
  ErrorText : string;
  pError : PChar;
begin
  GetMem(pError,256*2);   { make sure there is ample space if WideChar is used }
  waveInGetErrorText(iErr,pError,255);
  ErrorText:=StrPas(pError);
  FreeMem(pError,256*2);
  if length(ErrorText)=0 then FAudio.ErrorMessage:=Additional
  else FAudio.ErrorMessage:=Additional+' '+ErrorText;
end;

procedure TPlayer.AddNextOutBuffer2(var Msg: TMessage);
begin
   if (Msg.Msg=wom_DONE) and DeviceOpen then AddNextOutBuffer;
end;

function TPlayer.AddNextOutBuffer:longint;
var  iErr:integer;
     WritePos:Longint;
begin
  if (PlayStream<>nil) then begin
    FinishedPlaying:=false;
    WritePos:=PlayStream.Position;
    PlayStream.Position:=ReadPlayStreamPos;
    Result:=PlayStream.Read(pwaveheader[ForwardIndex]^.lpData^,WaveBufSize);
    if (Result=0) and (FNoOfRepeats>0) then begin
      dec(FNoOfRepeats,1);
      PlayStream.Position:=0;
      Result:=PlayStream.Read(pwaveheader[ForwardIndex]^.lpData^,WaveBufSize);
    end;
    ReadPlayStreamPos:=PlayStream.Position;
    PlayStream.Position:=WritePos;
    if Result>0 then begin
      pwaveheader[ForwardIndex]^.dwBufferLength:=Result;
      pwaveheader[ForwardIndex]^.dwFlags:=0;
      pwaveheader[ForwardIndex]^.dwLoops:=0;
      iErr:=waveOutPrepareHeader(WaveOut,pWaveHeader[ForwardIndex],sizeof(TWAVEHDR));
      if iErr<>0 then begin
        GetError(iErr,'');
        Exit;
      end;
      iErr:=waveOutWrite(WaveOut, pwaveheader[ForwardIndex], sizeof(TWAVEHDR));
      if iErr<>0 then begin
        GetError(iErr,'');
        Exit;
      end;
      ForwardIndex:=(ForwardIndex+1) mod No_Buffers;
      inc(ActiveBuffers);
    end else begin
      PlayStream.Free;
      PlayStream:=nil;
    end;
  end else Result:=0;
end;

procedure TPlayer.GetError(iErr : Integer; Additional:string);
var
  ErrorText : string;
  pError : PChar;
begin
  GetMem(pError,256*2);   { make sure there is ample space if WideChar is used }
  waveOutGetErrorText(iErr,pError,255);
  ErrorText:=StrPas(pError);
  FreeMem(pError,256*2);
  if length(ErrorText)=0 then FAudio.ErrorMessage:=Additional
  else FAudio.ErrorMessage:=Additional+' '+ErrorText;
end;

{$IFDEF WIN32}
{ Mixer Controls only available in the 32bit version          }
procedure TMixerSettings.InitiateControlDetails(var details:TMixerControlDetails;
              ControlID,Channels:dword; pvalues:pointer);
begin
 details.cbStruct := sizeof (details);
 details.dwControlID := ControlID;
 details.cChannels := Channels;
 details.cMultipleItems := 0;
 details.cbDetails := sizeof (dword);
 details.paDetails := pvalues;
end;

function TMixerSettings.SetControl(Dest,Source:Word; LeftVolume,RightVolume:Word; Mute:boolean):boolean;
var P:PMixDetails;
    err : integer;
    values : ValuesArray;
    details : TMixerControlDetails;
begin
  Result:=false;
  P:=MixerStart;
  if MixerReady then begin
    while (P<>nil) do begin
      if ((P^.Destination=Dest) and (P^.Source=Source)) then begin
        if P^.VolControlID<65535 then begin
          if P^.Mono then begin
            InitiateControlDetails(details,P^.VolControlID,1,@values);
          end else begin
            InitiateControlDetails(details,P^.VolControlID,2,@values);
          end;
          values[0]:= LeftVolume;
          values[1]:= RightVolume;
          err := mixerSetControlDetails (MixerHandle, @details, MIXER_SETCONTROLDETAILSF_VALUE);
          if err<>MMSYSERR_NOERROR then begin
            FAudio.ErrorMessage:='Volume SetControlError in Mixer';
            exit;
          end;
        end;
        if P^.MuteControlID<65535 then begin
          InitiateControlDetails(details,P^.MuteControlID,1,@values);
          if Mute then values[0]:= 1
          else values[0]:=0;
          err := mixerSetControlDetails (MixerHandle, @details, MIXER_SETCONTROLDETAILSF_VALUE);
          if err<>MMSYSERR_NOERROR then begin
            FAudio.ErrorMessage:='Mute SetControlError in Mixer';
            exit;
          end else Result:=true;
        end else Result:=true;
        Exit;
      end;
      P:=P^.Next;
    end;
  end;
end;

function TMixerSettings.GetControl(Dest,Source:Word; var LeftVolume,RightVolume:Word;
                                   var Mute:boolean; var CtrlType:byte):boolean;
var P:PMixDetails;
    err : integer;
    values : ValuesArray;
    details : TMixerControlDetails;
begin
  Result:=false;
  P:=MixerStart;
  if MixerReady then begin
    while (P<>nil) do begin
      if ((P^.Destination=Dest) and (P^.Source=Source)) then begin
        CtrlType:=byte(P^.CtrlType);
        if P^.Mono then InitiateControlDetails(details,P^.VolControlID,1,@values)
        else InitiateControlDetails(details,P^.VolControlID,2,@values);
        err := mixerGetControlDetails (MixerHandle, @details, MIXER_GETCONTROLDETAILSF_VALUE);
        if err<>MMSYSERR_NOERROR then begin
          FAudio.ErrorMessage:='Volume GetControlError in Mixer';
          exit;
        end;
        LeftVolume:=values[0];
        if P^.Mono then RightVolume:=LeftVolume
        else RightVolume:=values[1];
         InitiateControlDetails(details,P^.MuteControlID,1,@values);
        err := mixerGetControlDetails (MixerHandle, @details, MIXER_GETCONTROLDETAILSF_VALUE);
        if err<>MMSYSERR_NOERROR then begin
          FAudio.ErrorMessage:='Mute GetControlError in Mixer';
          exit;
        end;
        if values[0]=0 then Mute:=false
        else Mute:=true;
        Result:=true;
        Exit;
      end;
      P:=P^.Next;
    end;
  end;
end;

function TMixerSettings.GetMeter(Dest,Source:Word; var LeftVolume,RightVolume:dword):boolean;
var P:PMixDetails;
    err : integer;
    values, val2: PMixerControlDetailsSigned;
    details : TMixerControlDetails;
begin
  Result:=false;
  P:=MixerStart;
  if MixerReady then begin
    while (P<>nil) do begin
      if ((P^.Destination=Dest) and (P^.Source=Source) and (P^.Meter>0)) then begin
        GetMem(values, 2*SizeOf(TMixerControlDetailsSigned));
        InitiateControlDetails(details,P^.MeterControlID,P^.Meter,values);
        err := mixerGetControlDetails (MixerHandle, @details, MIXER_GETCONTROLDETAILSF_VALUE);
        if err<>MMSYSERR_NOERROR then exit;
        val2:=values;
        LeftVolume:=val2^.lValue;
        if P^.Meter=1 then RightVolume:=LeftVolume
        else begin
          inc(val2);
          RightVolume:=val2^.lValue;
        end;
        Result:=true;
        FreeMem(values, 2*SizeOf(TMixerControlDetailsSigned));
        Exit;
      end;
      P:=P^.Next;
    end;
  end;
end;

function TMixerSettings.GetName(Dest,Source:Word):string;
var P:PMixDetails;
begin
  Result:='';
  if MixerReady then begin
    P:=MixerStart;
    while (P<>nil) do begin
      if ((P^.Destination=Dest) and (P^.Source=Source)) then begin
        Result:=P^.Name;
        Exit;
      end;
      P:=P^.Next;
    end;
  end;
end;

function TMixerSettings.GetSources(Dest:Word):TStrings;
var P:PMixDetails;
begin
  P:=MixerStart;
  FList.Clear;
  if MixerReady then begin
    while P<>nil do begin
      if (P^.Destination=Dest) then begin
        if P^.Available then FList.Insert(P^.Source,P^.Name)
        else FList.Insert(P^.Source,'');
      end;
      P:=P^.Next;
    end;
  end;
  Result:=FList;
end;

function TMixerSettings.GetDestinations:TStrings;
var P:PMixDetails;
begin
  P:=MixerStart;
  FList.Clear;
  if MixerReady then begin
    while P<>nil do begin
      if (P^.Source=0) then FList.Insert(P^.Destination,P^.Name);
      P:=P^.Next;
    end;
  end;
  Result:=FList;
end;

function TMixerSettings.Query(var Product,Formats:string):boolean;
var
  PMix : PMixDetails;
  i : integer;
begin
  Result:=false;
  Product:=''; Formats:='';
  if MixerReady then begin
    if (mixerGetNumDevs=0) then begin
      Formats:='Mixer not present';
    end else begin
      PMix:=MixerStart;
      if PMix<>nil then Product:=PMix.Name;
      Formats:='Mixer devices present: '+IntToStr(mixerGetNumDevs)+'. DeviceID '+
               IntToStr(FAudio.FMixerDeviceID)+' has:';
      i:=0; PMix:=PMix^.Next;
      while PMix<>nil do begin
        if (PMix.Destination=i) then begin
          Formats:=Formats+#13#10+PMix.Name+': ';
          i:=i+1;
        end else begin
          Formats:=Formats+PMix.Name+', ';
        end;
        PMix:=PMix^.Next;
      end;
      Result:=true;
    end;
  end;
end;

procedure TMixerSettings.MixerCallBack(var Msg:TMessage);
var P : PMixDetails;
    Found : boolean;
begin
  if (Msg.Msg = MM_MIXM_CONTROL_CHANGE) and MixerReady then begin
    if (Assigned(FAudio.OnMixerChange)) then begin
      FAudio.OnMixerChange(Self,word(Msg.wParam),word(Msg.lParam));
      Found:=false;
      P:=MixerStart;
      while (P<>nil) and not(Found) do begin
        if (P^.VolControlID=Msg.lParam) or (P^.MuteControlID=Msg.lParam) then begin
          Found:=true;
          FAudio.OnMixerChange(Self,P^.Destination,P^.Source);
        end;
        P:=P^.Next;
      end;
    end;
  end;
end;

function TMixerSettings.GetMixerSettings(MixerDeviceID:integer):boolean;
var
  j, k, err : Integer;
  caps : TMixerCaps;
  lineInfo, connectionInfo : TMixerLine;
  PMix:PMixDetails;
  Data : ValuesArray;
  speakers : boolean;

procedure UpdateLinkedList(Update:Word; var P:PMixDetails; Destination, Source : dword; Name : string;
                           ControlID : dword; Data : ValuesArray; Mono, Speakers:boolean);
var
   TempDest,TempSource : word;
begin
 if (P<>nil) or (Update=0) then begin
  case Update of
  0 : begin
        new(P);
        P^.Next:=nil; P^.Available:=false; P^.Mono:=false;
        P^.Destination:=65535;
        P^.Source:=65535;
        P^.Name:=Name;
        P^.Speakers:=Speakers;
        P^.VolControlID:=65535; P^.Left:=0; P^.Right:=0;
        P^.MuteControlID:=65535; P^.Mute:=false;
        P^.MeterControlID:=65535; P^.Meter:=0;
        P^.CtrlType:=0;
      end;
  1 : begin
        TempDest:=P^.Destination; TempSource:=P^.Source;
        new(P^.Next); P:=P^.Next;
        P^.Next:=nil; P^.Available:=false; P^.Mono:=false;
        if (word(Destination)<>TempDest) then begin
          TempDest:=word(Destination);
          TempSource:=0;
        end else TempSource:=(TempSource+1) mod 65536;
        P^.Destination:=TempDest; P^.Source:=TempSource;
        P^.Name:=Name;
        P^.Speakers:=Speakers;
        P^.VolControlID:=65535; P^.Left:=0; P^.Right:=0;
        P^.MuteControlID:=65535; P^.Mute:=false;
        P^.MeterControlID:=65535; P^.Meter:=0;
        P^.CtrlType:=128;
      end;
  2 : begin
       if P^.MuteControlID=65535 then begin
         P^.MuteControlID:=ControlID;
         if Data[0]=0 then P^.Mute:=false
         else P^.Mute:=true;
         P^.Available:=true;
         P^.CtrlType:=(P^.CtrlType and 127);
       end;
      end;
  3 : begin
       P^.VolControlID:=ControlID;
       P^.Left:=Data[0];
       if Mono then begin
         P^.Mono:=true;
         P^.CtrlType:=P^.CtrlType+64;
       end else P^.Right:=Data[1];
       P^.Available:=true;
      end;
  4 : begin
       P^.MeterControlID:=ControlID;
       if Mono then P^.Meter:=1
       else P^.Meter:=2;
      end;
  end;
 end;
end;

function GetControl(var PMixer:PMixDetails; MixLine:TMixerLine; speakers:boolean):boolean;
var err,j:integer;
  mixerLineControls : TMixerLineControls;
  p, controls : PMixerControl;
  details : TMixerControlDetails;
  values : ValuesArray;
begin
   UpdateLinkedList(1,PMixer,MixLine.dwDestination,MixLine.dwSource,
      StrPas(MixLine.szName),word(MixLine.dwComponentType),Data,false,speakers);
   mixerLineControls.cbStruct := sizeof (mixerLineControls);
   mixerLineControls.dwLineID := MixLine.dwLineID;
   mixerLineControls.cControls := MixLine.cControls;
   mixerLineControls.cbmxctrl := sizeof (TMixerControl);
   if MixLine.cControls>0 then begin
     GetMem (controls, sizeof (TMixerControlW) * MixLine.cControls);  { make sure to reserve ample space even for WideChar }
     mixerLineControls.pamxctrl := controls;
     err:=mixerGetLineControls (MixerHandle, @mixerLineControls, MIXER_GETLINECONTROLSF_ALL);
     if  err=MMSYSERR_NOERROR then begin
       p := controls;
       for j := 0 to mixerLineControls.cControls - 1 do begin
         if (p^.dwControlType=MIXERCONTROL_CONTROLTYPE_VOLUME) then begin
            InitiateControlDetails(details,p^.dwControlID,MixLine.cChannels,@values);
            if mixerGetControlDetails (MixerHandle, @details, MIXER_GETCONTROLDETAILSF_VALUE) = MMSYSERR_NOERROR then
              UpdateLinkedList(3,PMixer,0,0,'',details.dwControlID,values,(MixLine.cChannels=1),speakers);
         end else begin
           if (p^.dwControlType=MIXERCONTROL_CONTROLTYPE_MUTE) then begin
            InitiateControlDetails(details,p^.dwControlID,1,@values);
            if mixerGetControlDetails (MixerHandle, @details, MIXER_GETCONTROLDETAILSF_VALUE) = MMSYSERR_NOERROR then
              UpdateLinkedList(2,PMixer,0,0,'',details.dwControlID,values,false,speakers);
           end else begin
              if (p^.dwControlType=MIXERCONTROL_CONTROLTYPE_PEAKMETER) then begin
                InitiateControlDetails(details,p^.dwControlID,MixLine.cChannels,@values);
                if mixerGetControlDetails (MixerHandle, @details, MIXER_GETCONTROLDETAILSF_VALUE) = MMSYSERR_NOERROR then
                  UpdateLinkedList(4,PMixer,0,0,'',details.dwControlID,values,(MixLine.cChannels=1),speakers);
              end;
           end;
         end;
         Inc (p);
       end;
       Result:=true;
     end else Result:=false;
     FreeMem (controls, sizeof (TMixerControlW) * MixLine.cControls);
   end else Result:=true;
end;

begin
  Result:=false; MixerStart:=nil; PMix:=nil;
  if mixerGetNumDevs=0 then begin
    exit;
  end else begin
    MixerGetDevCaps (MixerDeviceID, @caps, sizeof (caps));
    err:= mixerOpen (@MixerHandle, MixerDeviceID, MixerCallbackHandle, 0, CALLBACK_WINDOW OR MIXER_OBJECTF_MIXER);
    if err = MMSYSERR_NOERROR then begin
      UpdateLinkedList(0,MixerStart,dword(-1),dword(-2),StrPas(caps.szPname),0,Data,false,false);
      PMix:=MixerStart;
        for j := 0 to caps.cDestinations - 1 do begin
          lineInfo.cbStruct := sizeof (lineInfo);
          lineInfo.dwDestination := j;
          lineinfo.dwSource:=0;           { Added this line 990318/HBn }
          Result:=false;
          err:=mixerGetLineInfo (MixerHandle, @lineInfo, MIXER_GETLINEINFOF_DESTINATION);
          if err = MMSYSERR_NOERROR then begin
            speakers:=(lineInfo.dwComponentType=MIXERLINE_COMPONENTTYPE_DST_SPEAKERS);
            GetControl(PMix,lineInfo,speakers);
            for k := 0 to lineInfo.cConnections - 1 do begin
              connectionInfo.cbStruct := sizeof (connectionInfo);
              connectionInfo.dwDestination := j;
              connectionInfo.dwSource := k;
              Result:=false;
              err:=mixerGetLineInfo (MixerHandle, @connectionInfo, MIXER_GETLINEINFOF_SOURCE);
              if err = MMSYSERR_NOERROR then GetControl(PMix,connectionInfo,speakers)
              else exit;
            end;
            Result:=true;
          end else exit;
        end;
    end;
  end;
end;
{$ENDIF}

{------------- Public methods ---------------------------------------}
constructor TAudio.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   FDeviceID:=DefaultAudioDeviceID;
   FSepCtrl:=false;
   FVersion:=Ver;
   FRecorder:=TRecorder.Create; FRecorder.FAudio:=Self;
   FRecorder.Active:=false;
   FRecorder.FBPS:=BPSDefault;
   FRecorder.FNoSamples:=NoSamplesDefault;
   FRecorder.FChannels:=ChannelsDefault;
   FRecorder.FSPS:=SPSDefault;
   FRecorder.AddNextInBufferHandle:= AllocateHWnd(FRecorder.AddNextInBuffer2);
   FPlayer:=TPlayer.Create; FPlayer.FAudio:=Self;
   FPlayer.Active:=false;
   FPlayer.FBPS:=BPSDefault;
   FPlayer.FNoSamples:=NoSamplesDefault;
   FPlayer.FChannels:=ChannelsDefault;
   FPlayer.FSPS:=SPSDefault;
   FPlayer.PlayStream:=nil;
   FPlayer.FPlayFile:=false;
   FPlayer.ActiveBuffers:=0;
   FPlayer.AddNextOutBufferHandle:= AllocateHWnd(FPlayer.AddNextOutBuffer2);
   FPlayer.CloseHandle:=AllocateHWnd(FPlayer.Close2);
   FWindowHandle:=AllocateHWnd(AudioCallBack);
{$IFDEF WIN32}
   WaveFmtSize:=SizeOf(TWaveFormatEx);
   Mixer:=TMixerSettings.Create;
   Mixer.MixerReady:=false;
   Mixer.FAudio:=Self;
   FMixerDeviceID:=DefaultMixerDeviceID;
   Mixer.FList:=TStringList.Create;
   Mixer.MixerStart:=nil;
   Mixer.MixerCallbackHandle:=AllocateHWnd(Mixer.MixerCallback);
   if Mixer.GetMixerSettings(FMixerDeviceID) then Mixer.MixerReady:=true;
{$ELSE}
   WaveFmtSize:=SizeOf(TPCMWaveFormat);
{$ENDIF}
   FRecorder.RecToFile:=false; ErrorMessage:='';
   if (waveInGetNumDevs<1) then Exit;
   if not(FRecorder.AllocateMemory) then Exit;
   if (waveOutGetNumDevs<1) then Exit;
   if not(FPlayer.AllocateMemory) then Exit;
end;

destructor TAudio.Destroy;
var i:longint;
{$IFDEF WIN32}
    P1,P2 :PMixDetails;
{$ENDIF}
begin
   FPlayer.Stop;
   FRecorder.Stop;
{$IFDEF WIN32}
   Mixer.FList.Free;
   if Mixer.MixerStart<>nil then mixerClose(Mixer.MixerHandle);
   P1:=Mixer.MixerStart;
   while P1<>nil do begin
     P2:=P1.Next;
     Dispose(P1);
     P1:=P2;
   end;
  if Mixer.MixerCallbackHandle<>0 then DeAllocateHwnd(Mixer.MixerCallbackHandle);
  Mixer.Free;
{$ENDIF}
  with FRecorder do begin
   if RecToFile and (RecStream<>nil) then begin
     i:=RecStream.Size-8;    { size of file  }
     RecStream.Position:=4;
     RecStream.write(i,4);
     i:=i-$24;               { size of data  }
     RecStream.Position:=40;
     RecStream.write(i,4);
     RecStream.Free;
     RecToFile:=false;
   end;
 {  Close;       }
   FreeMemory;
   if AddNextInBufferHandle<>0 then DeallocateHWnd(AddNextInBufferHandle);
   Free;
  end;
  with FPlayer do begin
    FreeMemory;
    if AddNextOutBufferHandle<>0 then DeallocateHWnd(AddNextOutBufferHandle);
    if CloseHandle<>0 then DeallocateHWnd(CloseHandle);
    Free;
  end;
  if FWindowHandle<>0 then DeAllocateHWnd(FWindowHandle);
  inherited Destroy;
end;

function TAudio.Query(var Product,Formats:string):boolean;
var Caps : PWaveOutCaps;
    i1,i2,j1,j2 : Word;
    iErr : Integer;
begin
  Result:=false;
  Product:=''; Formats:='';
  if (waveInGetNumDevs<=FDeviceID) or (waveOutGetNumDevs<=FDeviceID) then begin
    ErrorMessage:='No waveform device available';
    Exit;
  end else begin
    GetMem(Caps,SizeOf(TWaveOutCapsW));
    iErr:=waveOutGetDevCaps(FDeviceID,Caps,SizeOf(TWaveOutCaps));
    if (iErr<>0) then begin
      FPlayer.GetError(iErr,'');
      Exit;
    end else begin
      Product:=StrPas(Caps^.szPname);
      Formats:='';
      if ((Caps^.dwFormats and WAVE_FORMAT_1M08)>0) then Formats:='11.025';
      if ((Caps^.dwFormats and WAVE_FORMAT_2M08)>0) then Formats:=Formats+'/22.05';
      if ((Caps^.dwFormats and WAVE_FORMAT_1M08)>0) then Formats:=Formats+'/44.1';
      Formats:=Formats+' kHz, ';
      if ((Caps^.dwFormats and WAVE_FORMAT_1M08)>0) then Formats:=Formats+'Mono';
      if ((Caps^.dwFormats and WAVE_FORMAT_1S08)>0) then Formats:=Formats+'/Stereo';
      if ((Caps^.dwFormats and WAVE_FORMAT_1M08)>0) then Formats:=Formats+', 8';
      if ((Caps^.dwFormats and WAVE_FORMAT_1M16)>0) then Formats:=Formats+'/16';
      Formats:=Formats+'-bit, Playback Controls: ';
      if ((Caps^.dwSupport and WAVECAPS_LRVOLUME)>0) then Formats:=Formats+'Separate L/R Volume'
      else if ((Caps^.dwSupport and WAVECAPS_VOLUME)>0) then Formats:=Formats+'Volume';
      FPlayer.GetVolume(i1,i2);
      FPlayer.SetVolume((i1+10) mod 65535,(i2+10) mod 65535);
      FPlayer.GetVolume(j1,j2);
      FPlayer.SetVolume(i1,i2);
      if not((j1=((i1+10) mod 65535)) and (j2=((i2+10) mod 65535))) then
        Formats:=Formats+' (not controllable with this DeviceID driver)';
      if ((Caps^.dwSupport and WAVECAPS_PITCH)>0) then Formats:=Formats+', Pitch';
      if ((Caps^.dwSupport and WAVECAPS_PLAYBACKRATE)>0) then Formats:=Formats+', Rate';
      if ((Caps^.dwSupport and WAVECAPS_SYNC)>0) then Formats:=Formats+', Synchronous Device';
      FRecorder.FPause:=true;
      FRecorder.Close;
      if (FPlayer.Open and FRecorder.Open) then begin
        if (FPlayer.DeviceOpen and FRecorder.DeviceOpen) then Formats:='Full-duplex support, '+Formats
        else Formats:='Half-duplex support, '+Formats;
      end else Formats:='Half-duplex support, '+Formats;
      FRecorder.Close;
      FRecorder.FPause:=false;
      PostMessage(FPlayer.CloseHandle,mm_wom_CLOSE,0,0);
     end;
    if Caps<>nil then FreeMem(Caps,SizeOf(TWaveOutCapsW));
  end;
  Result:=true;
end;

{ Callback routine used for CALLBACK_FUNCTION in waveInOpen    }
{$IFDEF WIN32}
procedure RecorderCallBack(hW:HWAVEIN; uMsg,dwInstance,dwParam1,dwParam2 : DWORD);  stdcall;
{$ELSE}
procedure RecorderCallBack(hW:HWAVEIN; uMsg,dwInstance,dwParam1,dwParam2 : LongInt);  stdcall;
{$ENDIF}
var LP,RP:pointer;
    Size:Word;
    RecPtr : PRecorder;
begin
  RecPtr := Pointer(dwInstance);
  with RecPtr^ do begin
   case uMsg of
    wim_OPEN  : Active:=true;
    wim_CLOSE : Active:=false;
    wim_DATA  : begin
                  if Active then begin
                    LP:=pWaveBuffer[ReturnIndex Mod No_Buffers];
                    RP:=pExtraBuffer[ReturnIndex Mod No_Buffers];
                    Size:=pWaveHeader[ReturnIndex Mod No_Buffers]^.dwBytesRecorded;
                    if (not(FPause) and TestTrigger(LP,Size)) then begin
                           if RecToFile then RecStream.write(LP^,Size);
                           if Assigned(FAudio.FOnAudioRecord) then begin
                             if FSplit then begin
                               Split(LP,RP,Size);
                               FAudio.FOnAudioRecord(RecPtr^,LP,RP,Size);
                             end else FAudio.FOnAudioRecord(RecPtr^,LP,nil,Size);
                           end;
                    end;
                    if (Size>0) then begin
                         PostMessage(AddNextInBufferHandle,wim_DATA,0,0);
                         ReturnIndex:=(ReturnIndex+1) mod No_Buffers;
                    end;
                  end;
                end;
   end;
  end;
end;

function TRecorder.Open : boolean;
var
  iErr, i : Integer;
begin
  if not(DeviceOpen) then begin
    Result:=false;
    ForwardIndex:=0;
    ReturnIndex:=0;
{$IFDEF WIN32}
   iErr:=waveInOpen(@WaveIn,FAudio.FDeviceID, pWaveFmt,dword(@RecorderCallBack),
                     dword(@FAudio.FRecorder), CALLBACK_FUNCTION+WAVE_ALLOWSYNC);
{  iErr:=waveInOpen(@WaveIn,FAudio.FDeviceID, pWaveFmt,FAudio.FWindowHandle,0, CALLBACK_WINDOW+WAVE_ALLOWSYNC); }
{$ELSE}
{  iErr:=waveInOpen(@WaveIn,FAudio.FDeviceID, @pWaveFmt^.wf,LongInt(@RecorderCallBack),
                    LongInt(@FAudio.FRecorder), CALLBACK_FUNCTION+WAVE_ALLOWSYNC);    }
{ Problem to get CALLBACK_FUNCTION to work in 16bit version    }
    iErr:=waveInOpen(@WaveIn,FAudio.FDeviceID, @pWaveFmt^.wf,FAudio.FWindowHandle,0, CALLBACK_WINDOW+WAVE_ALLOWSYNC);
{$ENDIF}
    if (iErr<>0) then begin
      Close;
      GetError(iErr,'Could not open the input device for recording: ');
      Exit;
    end;
    DeviceOpen:=true;
    InitWaveHeaders;
    for i:=0 to No_Buffers-1 do begin
     iErr:=waveInPrepareHeader(WaveIn, pWaveHeader[i], sizeof(TWAVEHDR));
       if (iErr<>0) then begin
           Close;
           GetError(iErr,'Error preparing header for recording: ');
           Exit;
       end;
    end;
    if not(AddNextInBuffer) then begin
      FAudio.ErrorMessage:='Error adding next input buffer';
      Exit;
    end;
  end;
  Result:=true;
end;

function TRecorder.Close : boolean;
var
  iErr,i : Integer;
begin
  Result:=false;
  if not(DeviceOpen) then begin
     FAudio.ErrorMessage:='Recorder already closed';
     Result:=true;
     Exit;
  end;
  if (waveInReset(WaveIn)<>0) then begin
     FAudio.ErrorMessage:='Error in waveInReset';
     Exit;
  end;
  for i:=0 to No_Buffers-1 do begin
     iErr:=waveInUnprepareHeader(WaveIn, pWaveHeader[i], sizeof(TWAVEHDR));
     if (iErr<>0) then begin
       GetError(iErr,'Error in waveInUnprepareHeader');
       Exit;
     end;
  end;
{$IFDEF WIN32}
  if (waveInClose(WaveIn)<>0) then begin
{$ELSE}
  if (correctedwaveInClose(WaveIn)<>0) then begin
{$ENDIF}
     FAudio.ErrorMessage:='Error closing input device';
     Exit;
  end;
  DeviceOpen:=false;
  Result:=true;
end;

function TRecorder.Start : boolean;
var
  iErr, i : Integer;
begin
  Result:=false;
  if Open then begin
    iErr:=WaveInStart(WaveIn);
    if (iErr<>0) then begin
      GetError(iErr,'Error starting wave record: ');
      Close;
      Result:=false;
      Exit;
    end;
    for i:=1 to No_Buffers-1 do
      if not(AddNextInBuffer) then begin
         FAudio.ErrorMessage:='Error adding next input buffer';
         Exit;
      end;
    Result:=true;
  end;
end;

function TRecorder.Stop : boolean;
var i:longint;
begin
  Active:=false;
  Result:=Close;
  if RecToFile then begin
    i:=RecStream.Size-8;    { size of file  }
    RecStream.Position:=4;
    RecStream.write(i,4);
    i:=i-$24;               { size of data   }
    RecStream.Position:=40;
    RecStream.write(i,4);
    RecStream.Free;
    RecToFile:=false;
  end;
  while Active do Application.ProcessMessages;
end;

procedure TRecorder.Pause;
begin
  if DeviceOpen then FPause:=true;
end;

procedure TRecorder.Restart;
begin
  if DeviceOpen then FPause:=false;
end;

procedure TRecorder.RecordToFile(FileName:string; LP,RP:TStream);
var temp:string;
    i : LongInt;
    T1,T2 : ^byte;
begin
  if FileName<>'' then begin
    RecToFile:=true;
    RecStream:=TFileStream.Create(FileName,fmCreate);
    temp:='RIFF';RecStream.write(temp[1],length(temp));
    temp:=#0#0#0#0;RecStream.write(temp[1],length(temp));     { File size: to be updated }
    temp:='WAVE';RecStream.write(temp[1],length(temp));
    temp:='fmt ';RecStream.write(temp[1],length(temp));
    temp:=#$10#0#0#0;RecStream.write(temp[1],length(temp));   { Fixed }
    temp:=#1#0;RecStream.write(temp[1],length(temp));         { PCM format }
    if FChannels=Mono then temp:=#1#0
    else temp:=#2#0;
    RecStream.write(temp[1],length(temp));
    RecStream.write(FSPS,2);
    temp:=#0#0;RecStream.write(temp[1],length(temp));         { SampleRate is given is dWord }
{$IFDEF WIN32}
    with pWaveFmt^ do begin
{$ELSE}
    with pWaveFmt^.wf do begin
{$ENDIF}
      RecStream.write(nAvgBytesPerSec,4);
      RecStream.write(nBlockAlign,2);
    end;
    RecStream.write(pWaveFmt^.wBitsPerSample,2);
    temp:='data';RecStream.write(temp[1],length(temp));
    temp:=#0#0#0#0;RecStream.write(temp[1],length(temp));    { Data size: to be updated }

    if (LP<>nil) then begin
      LP.Position:=0;
      if (RP<>nil) and (RP.Size=LP.Size) then begin
      RP.Position:=0;
      GetMem(T1,1000); T2:=T1;
      if FBPS=_8 then begin
        for i:=1 to LP.Size do begin
          LP.Read(T2^,1);inc(T2,1);
          RP.Read(T2^,1); inc(T2,1);
          if (i mod 500)=0 then begin
            RecStream.Write(T1^,1000);
            T2:=T1;
          end;
        end;
        i:=LP.Size mod 500;
        if i>0 then begin
          RecStream.Write(T1^,i*2);
        end;
      end else begin
        for i:=1 to (LP.Size div 2) do begin
          LP.Read(T2^,2);inc(T2,2);
          RP.Read(T2^,2); inc(T2,2);
          if (i mod 250)=0 then begin
            RecStream.Write(T1^,1000);
            T2:=T1;
          end;
        end;
        i:=(LP.Size div 2) mod 250;
        if i>0 then begin
          RecStream.Write(T1^,i*2);
        end;
      end;
      FreeMem(T1,1000);
    end else RecStream.CopyFrom(LP,LP.Size);
{
    if (LP<>nil) then begin
      LP.Position:=0;
      if (RP<>nil) and (RP.Size=LP.Size) then begin
        RP.Position:=0;
        if FBPS=_8 then begin
          for i:=1 to LP.Size do begin
             RecStream.CopyFrom(LP,1);
             RecStream.CopyFrom(RP,1);
          end;
        end else begin
          for i:=1 to (LP.Size div 2) do begin
             RecStream.CopyFrom(LP,2);
             RecStream.CopyFrom(RP,2);
          end;
        end;
      end else RecStream.CopyFrom(LP,LP.Size);
}
      i:=RecStream.Size-8;    { size of file  }
      RecStream.Position:=4;
      RecStream.write(i,4);
      i:=i-$24;               { size of data   }
      RecStream.Position:=40;
      RecStream.write(i,4);
      RecStream.Free;
      RecToFile:=false;
    end;
  end else RecToFile:=false;
end;

{ Callback routine used for CALLBACK_FUNCTION in waveOutOpen   }
{$IFDEF WIN32}
procedure PlayerCallBack(hW:HWAVEOUT; uMsg,dwInstance,dwParam1,dwParam2 : DWORD);  stdcall;
{$ELSE}
procedure PlayerCallBack(hW:HWAVEOUT; uMsg,dwInstance,dwParam1,dwParam2 : LongInt);  stdcall;
{$ENDIF}
var PlayPtr : PPlayer;
begin
  PlayPtr := Pointer(dwInstance);
  with PlayPtr^ do begin
   case uMsg of
    wom_OPEN  : Active:=true;
    wom_CLOSE : Active:=false;
    wom_DONE  : if Active then begin
                  if (ForwardIndex=ReturnIndex) then begin
                    if not(FinishedPlaying) then begin
                      FinishedPlaying:=true;
                      PostMessage(CloseHandle,mm_wom_CLOSE,0,0);
                    end;
                  end else begin
                    if Assigned(FAudio.FOnBufferPlayed) then FAudio.FOnBufferPlayed(PlayPtr^);
                    PostMessage(AddNextOutBufferHandle,wom_DONE,0,0);
                    ReturnIndex:=(ReturnIndex+1) mod No_Buffers;
                    dec(ActiveBuffers);
                  end;
                end;
   end;
  end;
end;

function TPlayer.Open : boolean;
var
  iErr : Integer;
begin
  if not(DeviceOpen) then begin
    Result:=false;
    ForwardIndex:=0;
    ActiveBuffers:=0;
    ReturnIndex:=1;  { necessary since ForwardIndex always is one more than being sent  }
{$IFDEF WIN32}
   iErr:=waveOutOpen(@WaveOut,FAudio.FDeviceID, pWaveFmt,dword(@PlayerCallBack),
                      dword(@FAudio.FPlayer), CALLBACK_FUNCTION+WAVE_ALLOWSYNC);
{  iErr:=waveOutOpen(@WaveOut,FAudio.FDeviceID, pWaveFmt,FAudio.FWindowHandle,0, CALLBACK_WINDOW+WAVE_ALLOWSYNC); }
{$ELSE}
{  iErr:=waveOutOpen(@WaveOut,FAudio.FDeviceID, @pWaveFmt^.wf,LongInt(@PlayerCallBack),
                    LongInt(@FAudio.FPlayer), CALLBACK_FUNCTION+WAVE_ALLOWSYNC);   }
{ Problem to get CALLBACK_FUNCTION to work in 16bit version     }
    iErr:=waveOutOpen(@WaveOut,FAudio.FDeviceID, @pWaveFmt^.wf,FAudio.FWindowHandle,0, CALLBACK_WINDOW+WAVE_ALLOWSYNC);
{$ENDIF}
    if (iErr<>0) then begin
      GetError(iErr,'Could not open the output device for playing: ');
      Exit;
    end;
    DeviceOpen:=true;
    InitWaveHeaders;
  end;
  Result:=true;
end;

procedure TPlayer.Play(LP,RP:TStream; NoOfRepeats:Word);
var i : LongInt;
    T1,T2 : ^byte;
begin
  if not(Open) then exit;
  if (LP<>nil) and (LP.Size>0) then begin
    if PlayStream=nil then begin
{       PlayStream:=TMemoryStream.Create;         }
    PlayStream:=TFileStream.Create('PLAY.TMP',fmCreate);
       FNoOfRepeats:=NoOfRepeats;
       ReadPlayStreamPos:=0;
    end else PlayStream.Position:=PlayStream.Size;
    if (FChannels=Stereo) and (RP<>nil) and (RP.Size=LP.Size) then begin
      LP.Position:=0; RP.Position:=0;
      GetMem(T1,1000); T2:=T1;
      if FBPS=_8 then begin
        for i:=1 to LP.Size do begin
          LP.Read(T2^,1);inc(T2,1);
          RP.Read(T2^,1); inc(T2,1);
          if (i mod 500)=0 then begin
            PlayStream.Write(T1^,1000);
            T2:=T1;
          end;
        end;
        i:=LP.Size mod 500;
        if i>0 then begin
          PlayStream.Write(T1^,i*2);
        end;
      end else begin
        for i:=1 to (LP.Size div 2) do begin
          LP.Read(T2^,2);inc(T2,2);
          RP.Read(T2^,2); inc(T2,2);
          if (i mod 250)=0 then begin
            PlayStream.Write(T1^,1000);
            T2:=T1;
          end;
        end;
        i:=(LP.Size div 2) mod 250;
        if i>0 then begin
          PlayStream.Write(T1^,i*2);
        end;
{      if FBPS=_8 then begin
        for i:=1 to LP.Size do begin
           PlayStream.CopyFrom(LP,1);
           PlayStream.CopyFrom(RP,1);
        end;
      end else begin
        for i:=1 to (LP.Size div 2) do begin
           PlayStream.CopyFrom(LP,2);
           PlayStream.CopyFrom(RP,2);
        end;
      end }
      end;
      FreeMem(T1,1000);
    end else begin
      LP.Position:=0;
      PlayStream.CopyFrom(LP,LP.Size);
    end;
    if ReadPlayStreamPos=0 then
      for i:=1 to No_Buffers do AddNextOutBuffer;
  end;
end;

procedure TPlayer.Close2(var Msg: TMessage);
var
  iErr, i : Integer;
begin
  if not(DeviceOpen) then begin
    FAudio.ErrorMessage:='Player already closed';
    exit;
  end;
  for i:=0 to No_Buffers-1 do begin
     iErr:=waveOutUnPrepareHeader(WaveOut, pWaveHeader[i], sizeof(TWAVEHDR));
     if (iErr<>0) then begin
       GetError(iErr,'Error unpreparing header for playing: ');
       Exit;
     end;
  end;
  iErr:=waveOutClose(WaveOut);
  if (iErr<>0) then begin
     GetError(iErr,'Error closing output device: ');
     Exit;
  end;
  DeviceOpen:=false;
  if (FPlayFile and (PlayStream=nil)) then begin
    SetChannels(FOldChannels);
    SetSPS(FOldSPS);
    SetBPS(FOldBPS);
    FPlayFile:=false;
  end;
  if Assigned(FAudio.FOnPlayed) then FAudio.FOnPlayed(Self);
end;

procedure TPlayer.Stop;
var iErr : integer;
begin
  if not(DeviceOpen) then begin
    FAudio.ErrorMessage:='Player already closed';
    exit;
  end;
  if PlayStream<>nil then begin
    PlayStream.Free;
    PlayStream:=nil;
    ForwardIndex:=ReturnIndex;
    FAudio.ErrorMessage:='';
  end;
  if not(FinishedPlaying) then begin
    iErr:=waveOutReset(WaveOut);
    if (iErr<>0) then begin
      FAudio.ErrorMessage:='Error in waveOutReset';
      Exit;
    end;
  end;
  while Active do Application.ProcessMessages;
end;

procedure TPlayer.Pause;
begin
  if DeviceOpen then waveOutPause(WaveOut);
end;

procedure TPlayer.Restart;
begin
  if DeviceOpen then waveOutRestart(WaveOut);
end;

procedure TPlayer.Reset;
begin
  if DeviceOpen then waveOutReset(WaveOut);
end;

procedure TPlayer.BreakLoop;
begin
  if DeviceOpen then waveOutBreakLoop(WaveOut);
end;

function TPlayer.PlayFile(FileName:string; NoOfRepeats:Word):boolean;
var temp:array[0..255] of byte;
    i : integer;
    Data:word;
    DataSize:longint;
begin
  Result:=false;
  if FileName<>'' then begin
    if (PlayStream=nil) then begin
      FOldChannels:=FChannels;
      FOldSPS:=FSPS;
      FOldBPS:=FBPS;
    end;
    PlayFileStream:=TFileStream.Create(FileName,fmOpenRead);
    PlayFileStream.Read(temp,22);
    PlayFileStream.Read(temp,2);
    if (temp[0]=2) then begin
      if (FChannels<>Stereo) then begin
        while FPlayFile do Application.ProcessMessages;
        SetChannels(Stereo);
      end;
    end else begin
      if (FChannels<>Mono) then begin
        while FPlayFile do Application.ProcessMessages;
        SetChannels(Mono);
      end;
    end;
    PlayFileStream.Read(temp,2);
    Data:=temp[1]*256+temp[0];
    if (FSPS<>Data) then begin
      while FPlayFile do Application.ProcessMessages;
      SetSPS(Data);
    end;
    PlayFileStream.Read(temp,8);
    PlayFileStream.Read(temp,2);
    if (temp[0]>8) then begin
      if (FBPS<>_16) then begin
        while FPlayFile do Application.ProcessMessages;
        SetBPS(_16);
      end;
    end else begin
      if (FBPS<>_8) then begin
        while FPlayFile do Application.ProcessMessages;
        SetBPS(_8);
      end;
    end;
    PlayFileStream.Read(temp,4); i:=0;
    while ((temp[i]<>$64) or (temp[i+1]<>$61) or (temp[i+2]<>$74) or (temp[i+3]<>$61)) do begin
      PlayFileStream.Read(temp[i+4],1);
      inc(i);
    end;
    PlayFileStream.Read(DataSize,4);
    FPlayFile:=true;
    if PlayStream=nil then begin
      if Open then begin
{        PlayStream:=TMemoryStream.Create;          }
        PlayStream:=TFileStream.Create('PLAY.TMP',fmCreate);
        FNoOfRepeats:=NoOfRepeats;
        ReadPlayStreamPos:=0;
      end else begin
        PlayFileStream.Free;
        exit;
      end;
    end else begin
      PlayStream.Position:=PlayStream.Size;
    end;
    PlayStream.CopyFrom(PlayFileStream,DataSize);
    if ReadPlayStreamPos=0 then
      for i:=1 to (No_Buffers-ActiveBuffers) do
        AddNextOutBuffer;
    PlayFileStream.Free;
    Result:=true;
  end;
end;

{------------- Property Controls ------------------------------------}

procedure TAudio.SetVersion(Value:string);
begin
  FVersion:=Ver;
end;

procedure TAudioSettings.SetChannels(Value:TChannels);
begin
  if FAudio.FSepCtrl then begin
    if FChannels<>Value then begin
      FChannels:=Value;
      FreeMemory;
      AllocateMemory;
    end;
  end else begin
    if FAudio.Player.FChannels<>Value then begin
      FAudio.Player.FChannels:=Value;
      FAudio.Player.FreeMemory;
      FAudio.Player.AllocateMemory;
    end;
    if FAudio.Recorder.FChannels<>Value then begin
      FAudio.Recorder.FChannels:=Value;
      FAudio.Recorder.FreeMemory;
      FAudio.Recorder.AllocateMemory;
    end;
  end;
  FAudio.Recorder.SetSplit(FAudio.FRecorder.FSplit);
end;

procedure TAudioSettings.SetBPS(Value:TBPS);
begin
  if FAudio.FSepCtrl then begin
    if FBPS<>Value then begin
      FBPS:=Value;
      FreeMemory;
      AllocateMemory;
    end;
  end else begin
    if FAudio.Player.FBPS<>Value then begin
      FAudio.Player.FBPS:=Value;
      FAudio.Player.FreeMemory;
      FAudio.Player.AllocateMemory;
    end;
    if FAudio.Recorder.FBPS<>Value then begin
      FAudio.Recorder.FBPS:=Value;
      FAudio.Recorder.FreeMemory;
      FAudio.Recorder.AllocateMemory;
    end;
  end;
end;

procedure TAudioSettings.SetSPS(Value:Word);
begin
  if FAudio.FSepCtrl then begin
    if FSPS<>Value then begin
      FSPS:=Value;
      FreeMemory;
      AllocateMemory;
    end;
  end else begin
    if FAudio.Player.FSPS<>Value then begin
      FAudio.Player.FSPS:=Value;
      FAudio.Player.FreeMemory;
      FAudio.Player.AllocateMemory;
    end;
    if FAudio.Recorder.FSPS<>Value then begin
      FAudio.Recorder.FSPS:=Value;
      FAudio.Recorder.FreeMemory;
      FAudio.Recorder.AllocateMemory;
    end;
  end;

end;

procedure TRecorder.SetNoSamples(Value:Word);
begin
  if FAudio.Player.FNoSamples<>Value then begin
      FAudio.Player.FNoSamples:=Value;
      FAudio.Player.FreeMemory;
      FAudio.Player.AllocateMemory;
  end;
  if FAudio.Recorder.FNoSamples<>Value then begin
      FAudio.Recorder.FNoSamples:=Value;
      FAudio.Recorder.FreeMemory;
      FAudio.Recorder.AllocateMemory;
  end;
end;

procedure TRecorder.SetSplit(Value:Boolean);
begin
  if FChannels=Stereo then begin
    if FSplit<>Value then FSplit:=Value;
  end else FSplit:=false;
end;

procedure TRecorder.SetTrigLevel(Value:Word);
begin
  if FTrigLevel<>Value then FTrigLevel:=Value;
end;

procedure TPlayer.GetVolume(var LeftVolume,RightVolume:Word);
var
  iErr : Integer;
{$IFDEF WIN32}
  Vol : dword;
{$ELSE}
  Vol : longint;
{$ENDIF}
begin
  iErr:=waveOutGetVolume(FAudio.FDeviceID,@Vol);
  if (iErr<>0) then GetError(iErr,'');
  LeftVolume:=Word(Vol and $FFFF);
  RightVolume:=Word(Vol shr 16);
end;

procedure TPlayer.SetVolume(LeftVolume,RightVolume:Word);
var
  iErr : Integer;
{$IFDEF WIN32}
  Vol : dword;
{$ELSE}
  Vol : longint;
{$ENDIF}
begin
  Vol:=RightVolume;
  Vol:=(Vol shl 16)+LeftVolume;
  iErr:=waveOutSetVolume(FAudio.FDeviceID,Vol);
  if (iErr<>0) then GetError(iErr,'');
end;

procedure TAudio.SetDeviceID(Value:Integer);
begin
  if FDeviceID<>Value then begin
    if Value>9 then FDeviceID:=WAVE_MAPPER
    else FDeviceID:=Value;
    FRecorder.FreeMemory;
    FRecorder.AllocateMemory;
    FPlayer.FreeMemory;
    FPlayer.AllocateMemory;
  end;
end;

{$IFDEF WIN32}
procedure TAudio.SetMixerDeviceID(Value:Integer);
begin
  if FMixerDeviceID<>Value then begin
    FMixerDeviceID:=Value;
    if Mixer.GetMixerSettings(FMixerDeviceID) then Mixer.MixerReady:=true;
  end;
end;
{$ENDIF}

procedure Register;
begin
  RegisterComponents('Interface', [TAudio]);
end;

end.