mixing.pas

灰鸽子VIP1.2经典源代码

      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