mixing.pas

灰鸽子VIP1.2经典源代码

@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;