audiostream.pas

VCL component dsplab , STFT and SPECTRUM viewer, real time

      raise;
    end;
  end;
end;


procedure TdspAudioStream.Stop;
begin
  if FPlaying then
  begin
    FPlaying:= False;
    SetEvent(FNotifyEvent); // Terminate Notification Thread
    FDSBuffer.Stop;
  end;
end;


procedure TdspAudioStream.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 TdspAudioStream.SetBufferLength(Value: Integer);
begin
  Value:= Max(10, Value);
  if FBufferLength <> Value then
  begin
    FBufferLength:= Value;
    if FWaveStream <> nil then RecreateBuf;
  end;
end;


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

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

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

    FillChar(BufferDesc, SizeOf(BufferDesc), 0);
    with BufferDesc do
    begin
      dwSize:= SizeOf(TDSBufferDesc);
      dwFlags:= DSBCAPS_CTRLDEFAULT or DSBCAPS_GETCURRENTPOSITION2;
      if soStickyFocus in FDSound.NowOptions then dwFlags:= dwFlags or DSBCAPS_STICKYFOCUS else
      if soGlobalFocus in FDSound.NowOptions then dwFlags:= dwFlags or DSBCAPS_GLOBALFOCUS;
      dwBufferBytes:= FDSBufferSize;
      lpwfxFormat:= Value.Format;
      lpwfxFormat.wBitsPerSample:= 16;
    end;

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

  FWaveStream := Value;
end;

function TdspAudioStream.GetWriteSize: Integer;
var
  PlayPosition: DWORD;
begin
  PlayPosition := FDSBuffer.Position;

  if FBufferPos <= PlayPosition then Result := PlayPosition - FBufferPos
  else Result := PlayPosition + (FDSBufferSize - FBufferPos);

  Result:= Result - (Result mod 4);
end;

procedure TdspAudioStream.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 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;
  except
    if InThread then
      SetEvent(FNotifyEvent)
    else
      Stop;
    raise;
  end;
end;


function  TdspAudioStream.Read(var Data; DataSize: Longint): Longint;
var
  ReadBytes: Longint;
  BytesToCopy: Longint;
  SrcBuf, DestBuf: PChar;
begin
  Result:= 0;
  DestBuf:= @Data;
  while DataSize > 0 do
  begin
    //1. LoadBuffer
    if FdspBufferPos >= FdspBufferSize then
    begin
      FdspBufferPos:= 0;
      ReadBytes:= FWaveStream.Read(FdspBuffer^, FdspBufferSize);

      if ReadBytes < FdspBufferSize then
        FillChar(
          Pointer(Integer(FdspBuffer) + ReadBytes)^,
          FdspBufferSize - ReadBytes, 0);

      //2. ProcessBuffer
      if Assigned(FOnDataProcessing) then FOnDataProcessing(FdspBuffer^, FdspBufferSize);
    end;

    //3. CopyToExternalBuffer
    SrcBuf:= FdspBuffer; Inc(SrcBuf, FdspBufferPos);
    BytesToCopy:= FdspBufferSize - FdspBufferPos;
    if BytesToCopy > DataSize then BytesToCopy:= DataSize;
    Move(SrcBuf^, DestBuf^, BytesToCopy);
    Inc(DestBuf, BytesToCopy);
    Inc(Result, BytesToCopy);
    Inc(FdspBufferPos, BytesToCopy);
    Dec(DataSize, BytesToCopy);
  end;
end;


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

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

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

        FBufferPos := (FBufferPos + DWORD(Data1Size) + DWORD(Data2Size)) mod FDSBufferSize;
      finally
        FDSBuffer.UnLock;
      end;
    end;
  end;

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

        if (Data2<>nil) and (s1=Data1Size) then
        begin
          s2 := Read(Data2^, Data2Size);
          FWritePosition := FWritePosition + s2;
          FBufferPos := (FBufferPos + DWORD(s2)) mod FDSBufferSize;
          Inc(Result, s2);
        end;
      finally
        FDSBuffer.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 FDSBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, Data2Size) then
    begin
      try
        FillChar(Data1^, Data1Size, C);

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

var
  DataSize: Integer;
begin
  if Size>=0 then
  begin
    Result := WriteSize;
    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 else
  begin
    Result:= 0;
    WriteData2(WriteSize);
  end;
end;


{  TdspAudioFileStream  }

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


procedure TdspAudioFileStream.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);

      if (FWaveFileStream.Format.wBitsPerSample <> 16) then
        raise Exception.Create('This demo supports 16 bits per sample audio only');

      WaveStream:= FWaveFileStream;
    except
      WaveStream:= nil;
      FFileName:= '';
      raise;
    end;
  end;
end;

end.