dxsounds.pas

原版翎风(LF)引擎(M2)源码(Delphi)

function TAudioStream.GetFrequency: Integer;
begin
  Result := FBuffer.Frequency;
end;

function TAudioStream.GetPan: Integer;
begin
  Result := FBuffer.Pan;
end;

function TAudioStream.GetPlayedSize: Integer;
begin
  if Playing then UpdatePlayedSize;
  Result := FPlayedSize;
end;

function TAudioStream.GetSize: Integer;
begin
  if WaveStream<>nil then
    Result := WaveStream.Size
  else
    Result := 0;
end;

function TAudioStream.GetVolume: Integer;
begin
  Result := FBuffer.Volume;
end;

procedure TAudioStream.UpdatePlayedSize;
var
  PlayPosition, PlayedSize: DWORD;
begin
  PlayPosition := FBuffer.Position;

  if FPlayBufferPos <= PlayPosition then
  begin
    PlayedSize := PlayPosition - FPlayBufferPos
  end else
  begin
    PlayedSize := PlayPosition + (FBufferSize - FPlayBufferPos);
  end;

  Inc(FPlayedSize, PlayedSize);

  FPlayBufferPos := PlayPosition;
end;

function TAudioStream.GetWriteSize: Integer;
var
  PlayPosition: DWORD;
  i: Integer;
begin
  PlayPosition := FBuffer.Position;

  if FBufferPos <= PlayPosition then
  begin
    Result := PlayPosition - FBufferPos
  end else
  begin
    Result := PlayPosition + (FBufferSize - FBufferPos);
  end;

  i := WaveStream.FilledSize;
  if i>=0 then Result := Min(Result, i);
end;

procedure TAudioStream.Play;
begin
  if not FPlaying then
  begin
    if WaveStream=nil then
      raise EAudioStreamError.Create(SWaveStreamNotSet);

    if Size=0 then Exit;

    FPlaying := True;
    try
      SetPosition(FPosition);
      if FAutoUpdate then
        FNotifyThread := TAudioStreamNotify.Create(Self);
    except
      Stop;
      raise;
    end;
  end;
end;

procedure TAudioStream.RecreateBuf;
var
  APlaying: Boolean;
  APosition: Integer;
  AFrequency: Integer;
  APan: Integer;
  AVolume: Integer;
begin
  APlaying := Playing;
     
  APosition := Position;
  AFrequency := Frequency;
  APan := Pan;
  AVolume := Volume;
                        
  SetWaveStream(WaveStream);

  Position := APosition;
  Frequency := AFrequency;
  Pan := APan;
  Volume := AVolume;
                  
  if APlaying then Play;
end;

procedure TAudioStream.SetAutoUpdate(Value: Boolean);
begin
  if FAutoUpdate<>Value then
  begin
    FAutoUpdate := Value;
    if FPlaying then
    begin
      if FNotifyThread<>nil then
      begin
        (FNotifyThread as TAudioStreamNotify).FStopOnTerminate := False;
        FNotifyThread.Free;
      end;

      if FAutoUpdate then
        FNotifyThread := TAudioStreamNotify.Create(Self);
    end;
  end;
end;

procedure TAudioStream.SetBufferLength(Value: Integer);
begin
  if Value<10 then Value := 10;
  if FBufferLength<>Value then
  begin
    FBufferLength := Value;
    if WaveStream<>nil then RecreateBuf;
  end;
end;

procedure TAudioStream.SetFrequency(Value: Integer);
begin
  FBuffer.Frequency := Value;
end;

procedure TAudioStream.SetLooped(Value: Boolean);
begin
  if FLooped<>Value then
  begin
    FLooped := Value;
    Position := Position;
  end;
end;

procedure TAudioStream.SetPan(Value: Integer);
begin
  FBuffer.Pan := Value;
end;

procedure TAudioStream.SetPlayedSize(Value: Integer);
begin
  if Playing then UpdatePlayedSize;
  FPlayedSize := Value;
end;

procedure TAudioStream.SetPosition(Value: Integer);
begin
  if WaveStream=nil then
    raise EAudioStreamError.Create(SWaveStreamNotSet);

  Value := Max(Min(Value, Size-1), 0);
  Value := Value div Format^.nBlockAlign * Format^.nBlockAlign;

  FPosition := Value;

  if Playing then
  begin
    try
      FBuffer.Stop;

      FBufferPos := 0;
      FPlayBufferPos := 0;
      FWritePosition := Value;

      WriteWave(FBufferSize);

      FBuffer.Position := 0;
      FBuffer.Play(True);
    except
      Stop;
      raise;
    end;
  end;
end;

procedure TAudioStream.SetVolume(Value: Integer);
begin
  FBuffer.Volume := Value;
end;

procedure TAudioStream.SetWaveStream(Value: TCustomWaveStream);
var
  BufferDesc: TDSBufferDesc;
begin
  Stop;

  FWaveStream := nil;
  FBufferPos := 0;
  FPosition := 0;
  FWritePosition := 0;

  if (Value<>nil) and (FBufferLength>0) then
  begin
    FBufferSize := FBufferLength * Integer(Value.Format^.nAvgBytesPerSec) div 1000;

    FillChar(BufferDesc, SizeOf(BufferDesc), 0);
    with BufferDesc do
    begin
      dwSize := SizeOf(TDSBufferDesc);
      dwFlags := DSBCAPS_CTRLDEFAULT or DSBCAPS_GETCURRENTPOSITION2;
      if FDSound.FStickyFocus then
        dwFlags := dwFlags or DSBCAPS_STICKYFOCUS
      else if FDSound.FGlobalFocus then
        dwFlags := dwFlags or DSBCAPS_GLOBALFOCUS;
      dwBufferBytes := FBufferSize;
      lpwfxFormat := Value.Format;
    end;

    if not FBuffer.CreateBuffer(BufferDesc) then
      raise EDirectSoundBufferError.CreateFmt(SCannotMade, [SDirectSoundBuffer]);
  end else
  begin
    FBuffer.IDSBuffer := nil;
    FBufferSize := 0;
  end;

  FWaveStream := Value;
end;

procedure TAudioStream.Stop;
begin
  if FPlaying then
  begin
    FPlaying := False;
    FBuffer.Stop;
    FNotifyThread.Free;
  end;
end;

procedure TAudioStream.Update;
begin
  Update2(False);
end;

procedure TAudioStream.Update2(InThread: Boolean);
var
  WriteSize: Integer;
begin
  if not FPlaying then Exit;

  try
    UpdatePlayedSize;

    if Size<0 then
    begin
      WriteSize := GetWriteSize;
      if WriteSize>0 then
      begin
        WriteSize := WriteWave(WriteSize);
        FPosition := FPosition + WriteSize;
      end;
    end else
    begin
      if FLooped then
      begin
        WriteSize := GetWriteSize;
        if WriteSize>0 then
        begin
          WriteWave(WriteSize);
          FPosition := (FPosition + WriteSize) mod Size;
        end;
      end else
      begin
        if FPosition<Size then
        begin
          WriteSize := GetWriteSize;
          if WriteSize>0 then
          begin
            WriteWave(WriteSize);
            FPosition := FPosition + WriteSize;
            if FPosition>Size then FPosition := Size;
          end;
        end else
        begin
          if InThread then
            SetEvent(FNotifyEvent)
          else
            Stop;
        end;
      end;
    end;
  except
    if InThread then
      SetEvent(FNotifyEvent)
    else
      Stop;
    raise;
  end;
end;

function TAudioStream.WriteWave(WriteSize: Integer): Integer;

  procedure WriteData(Size: Integer);
  var
    Data1, Data2: Pointer;
    Data1Size, Data2Size: Longint;
  begin
    if FBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, Data2Size) then
    begin
      try
        FWaveStream.Position := FWritePosition;
        FWaveStream.ReadBuffer(Data1^, Data1Size);
        FWritePosition := FWritePosition + Data1Size;

        if Data2<>nil then
        begin
          FWaveStream.ReadBuffer(Data2^, Data2Size);
          FWritePosition := FWritePosition + Data2Size;
        end;

        FBufferPos := (FBufferPos + DWORD(Data1Size) + DWORD(Data2Size)) mod FBufferSize;
      finally
        FBuffer.UnLock;
      end;
    end;
  end;

  procedure WriteData2(Size: Integer);
  var
    Data1, Data2: Pointer;
    Data1Size, Data2Size, s1, s2: Longint;
  begin
    if FBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, Data2Size) then
    begin
      try
        FWaveStream.Position := FWritePosition;
        s1 := FWaveStream.Read(Data1^, Data1Size);
        FWritePosition := FWritePosition + s1;
        FBufferPos := (FBufferPos + DWORD(s1)) mod FBufferSize;
        Inc(Result, s1);

        if (Data2<>nil) and (s1=Data1Size) then
        begin
          s2 := FWaveStream.Read(Data2^, Data2Size);
          FWritePosition := FWritePosition + s2;
          FBufferPos := (FBufferPos + DWORD(s2)) mod FBufferSize;
          Inc(Result, s2);
        end;
      finally
        FBuffer.UnLock;
      end;
    end;
  end;

  procedure WriteSilence(Size: Integer);
  var
    C: Byte;
    Data1, Data2: Pointer;
    Data1Size, Data2Size: Longint;
  begin
    if Format^.wBitsPerSample=8 then C := $80 else C := 0;

    if FBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, Data2Size) then
    begin
      try
        FillChar(Data1^, Data1Size, C);

        if Data2<>nil then
          FillChar(Data2^, Data2Size, C);
      finally
        FBuffer.UnLock;
      end;
      FBufferPos := (FBufferPos + DWORD(Data1Size) + DWORD(Data2Size)) mod FBufferSize;
      FWritePosition := FWritePosition + Data1Size + Data2Size;
    end;
  end;

var
  DataSize: Integer;
begin
  if Size>=0 then
  begin
    Result := WriteSize;
    if FLooped then
    begin
      while WriteSize>0 do
      begin
        DataSize := Min(Size-FWritePosition, WriteSize);

        WriteData(DataSize);
        FWritePosition := FWritePosition mod Size;

        Dec(WriteSize, DataSize);
      end;
    end else
    begin
      DataSize := Size-FWritePosition;

      if DataSize<=0 then
      begin
        WriteSilence(WriteSize);
      end else
      if DataSize>=WriteSize then
      begin
        WriteData(WriteSize);
      end else
      begin
        WriteData(DataSize);
        WriteSilence(WriteSize-DataSize);
      end;
    end;
  end else
  begin
    Result := 0;
    WriteData2(WriteSize);
  end;
end;

{  TAudioFileStream  }

destructor TAudioFileStream.Destroy;
begin
  inherited Destroy;
  FWaveFileStream.Free;
end;

procedure TAudioFileStream.SetFileName(const Value: string);
begin
  if FFileName=Value then Exit;

  FFileName := Value;

  if FWaveFileStream<>nil then
  begin
    WaveStream := nil;
    FWaveFileStream.Free;
    FWaveFileStream := nil;
  end;

  if Value<>'' then
  begin
    try
      FWaveFileStream := TWaveFileStream.Create(Value, fmOpenRead or fmShareDenyWrite);
      FWaveFileStream.Open(False);
      WaveStream := FWaveFileStream;
    except
      WaveStream := nil;
      FFileName := '';
      raise;
    end;
  end;
end;

{  TSoundCaptureFormats  }

constructor TSoundCaptureFormats.Create;
begin
  inherited Create(TSoundCaptureFormat);
end;

function TSoundCaptureFormats.GetItem(Index: Integer): TSoundCaptureFormat;
begin
  Result := TSoundCaptureFormat(inherited Items[Index]);
end;

function TSoundCaptureFormats.IndexOf(ASamplesPerSec, ABitsPerSample, AChannels: Integer): Integer;
var
  i: Integer;
begin
  Result := -1;
  for i:=0 to Count-1 do
    with Items[i] do
      if (FSamplesPerSec=ASamplesPerSec) and (FBitsPerSample=ABitsPerSample) and (FChannels=AChannels) then
      begin
        Result := i;
        Break;
      end;
end;

{  TSoundCaptureStream  }

type
  TSoundCaptureStreamNotify = class(TThread)
  private
    FCapture: TSoundCaptureStream;
    FSleepTime: Integer;
    constructor Create(Capture: TSoundCaptureStream);
    destructor Destroy; override;
    procedure Execute; override;
    procedure Update;
  end;

constructor TSoundCaptureStreamNotify.Create(Capture: TSoundCaptureStream);
begin
  FCapture := Capture;

  FCapture.FNotifyEvent := CreateEvent(nil, False, False, nil);
  FSleepTime := Min(FCapture.FBufferLength div 4, 1000 div 20);

  FreeOnTerminate := True;
  inherited Create(True);
end;

destructor TSoundCaptureStreamNotify.Destroy;
begin
  FreeOnTerminate := False;
  SetEvent(FCapture.FNotifyEvent);