mixing.pas

灰鸽子VIP1.2经典源代码

          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.