⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 audiostream.pas

📁 VCL component dsplab , STFT and SPECTRUM viewer, real time
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{
  The simple demo of sound processing
  Author:  Eugen Tarasov

  There is implementation of audio stream support.
  This unit is based on the DelphiX library.

  It contains:

  TdspAudioStream - play sound from any stream.

  TdspWaveFileStream - stream for working with the wav-files.
    The heard of this class is notification event to process
    a piece of sound data.

  TdspAudioFileStream - the derived class from TdspAudioStream.
    This class implements the sound playing from wav-file.
    This is the heard of our sound engine :)

  Last modified - January, 2004

  You can use this module on you own risk.
  Please send all suggestions to author

  e-mail: dsplab@teworks.com
  http://www.teworks.com
}

unit AudioStream;

interface

uses
  Forms, SysUtils, Windows, Wave, Classes, DXSounds, MMSystem, Math,
  DXConsts, DirectX, DXClass;

type
  TOnDataProcessing = procedure(var Buffer; Count: Longint) of object;

  TdspAudioStream = class
  private
    // DirectSound
    FDSound: TDXSound;
    // Direct Sound buffer
    FDSBuffer: TDirectSoundBuffer;
    FDSBufferSize: DWORD;
    FBufferLength: Integer;
    FBufferPos: DWORD;
    FPlayBufferPos: DWORD;
    FPlayedSize: Integer;
    FPlaying: Boolean;
    FPosition: Integer;
    FWaveStream: TCustomWaveStream;
    FWritePosition: Integer;
    FNotifyEvent: THandle;
    FNotifyThread: TThread;
    function GetFormat: PWaveFormatEX;
    function GetFrequency: Integer;
    function GetPan: Integer;
    function GetPlayedSize: Integer;
    function GetSize: Integer;
    function GetVolume: Integer;
    function GetWriteSize: Integer;
    procedure SetBufferLength(Value: Integer);
    procedure SetFrequency(Value: Integer);
    procedure SetPan(Value: Integer);
    procedure SetPlayedSize(Value: Integer);
    procedure SetPosition(Value: Integer);
    procedure SetVolume(Value: Integer);
    procedure SetWaveStream(Value: TCustomWaveStream);
    procedure Update2(InThread: Boolean);
    procedure UpdatePlayedSize;
    function WriteWave(WriteSize: Integer): Integer;
    procedure RecreateBuf;

  private
    FdspBufferSize: Longint;
    FdspBufferPos: Longint;
    FdspBuffer: Pointer;
    FOnDataProcessing: TOnDataProcessing;

    procedure FSetdspBufferSize(NewSize: Integer);

  protected
    function  Read(var Data; DataSize: Longint): Longint;

  public
    constructor Create(ADXSound: TDXSound);
    destructor Destroy; override;

    procedure Play;
    procedure Stop;

    property BufferLength: Integer read FBufferLength write SetBufferLength;
    property Format: PWaveFormatEx read GetFormat;

    property Volume: Integer read GetVolume write SetVolume;
    property Frequency: Integer read GetFrequency write SetFrequency;
    property Pan: Integer read GetPan write SetPan;
    property Position: Integer read FPosition write SetPosition;

    property Size: Integer read GetSize;
    property PlayedSize: Integer read GetPlayedSize write SetPlayedSize;
    property Playing: Boolean read FPlaying;

    property WaveStream: TCustomWaveStream read FWaveStream write SetWaveStream;
    property dspBufferSize: Longint read FdspBufferSize write FSetdspBufferSize;

    property OnDataProcessing: TOnDataProcessing read FOnDataProcessing write FOnDataProcessing;
  end;

  {  TdspAudioFileStream  }

  TdspAudioFileStream = class(TdspAudioStream)
  private
    FFileName: string;
    FWaveFileStream: TWaveFileStream;

    procedure SetFileName(const Value: string);
  public
    destructor Destroy; override;
    property FileName: string read FFileName write SetFileName;
  end;


implementation

{  TdspAudioStreamNotify  }

type
  TdspAudioStreamNotify = class(TThread)
  private
    FAudio: TdspAudioStream;
    FSleepTime: Integer;
  public
    constructor Create(Audio: TdspAudioStream);
    destructor Destroy; override;
    procedure Execute; override;
    procedure Update;
  end;


constructor TdspAudioStreamNotify.Create(Audio: TdspAudioStream);
begin
  inherited Create(True);
  FreeOnTerminate:= True;
  FAudio:= Audio;
  FAudio.FNotifyEvent:= CreateEvent(nil, False, False, nil);
  FSleepTime:= 50;
  Resume;
end;


destructor TdspAudioStreamNotify.Destroy;
begin
  FAudio.Stop;
  CloseHandle(FAudio.FNotifyEvent);
  inherited Destroy;
end;


procedure TdspAudioStreamNotify.Execute;
begin
  while WaitForSingleObject(FAudio.FNotifyEvent, FSleepTime) = WAIT_TIMEOUT do Synchronize(Update);
end;

procedure TdspAudioStreamNotify.Update;
begin
  try
    FAudio.Update2(True);
  except
    on E: Exception do
    begin
      Application.HandleException(E);
      SetEvent(FAudio.FNotifyEvent); // Terminate Thread
    end;
  end;
end;


{  TdspAudioStream  }

constructor TdspAudioStream.Create(ADXSound: TDXSound);
begin
  inherited Create;
  FDSound:= ADXSound;
  FDSBuffer:= TDirectSoundBuffer.Create(FDSound.DSound);
  BufferLength:= 1000;
  dspBufferSize:= 512 * 4;
end;


destructor TdspAudioStream.Destroy;
begin
  Stop;
  FDSBuffer.Free;
  dspBufferSize:= 0;
  inherited Destroy;
end;


procedure TdspAudioStream.FSetdspBufferSize(NewSize: Integer);
begin
  if NewSize <> FdspBufferSize then
  begin
    ReallocMem(FdspBuffer, NewSize);
    FdspBufferSize:= NewSize;
    FdspBufferPos:= FdspBufferSize;
  end;
end;


function TdspAudioStream.GetFormat: PWaveFormatEX;
begin
  if FWaveStream = nil then Result:= nil
  else Result:= WaveStream.Format;
end;


function TdspAudioStream.GetFrequency: Integer;
begin
  Result:= FDSBuffer.Frequency;
end;


procedure TdspAudioStream.SetFrequency(Value: Integer);
begin
  FDSBuffer.Frequency:= Value;
end;


function TdspAudioStream.GetPan: Integer;
begin
  Result:= FDSBuffer.Pan;
end;


procedure TdspAudioStream.SetPan(Value: Integer);
begin
  FDSBuffer.Pan:= Value;
end;


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


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


function TdspAudioStream.GetVolume: Integer;
begin
  Result:= FDSBuffer.Volume;
end;


procedure TdspAudioStream.SetVolume(Value: Integer);
begin
  FDSBuffer.Volume:= Value;
end;


procedure TdspAudioStream.SetPosition(Value: Integer);
begin
  if not Assigned(FWaveStream) then Exit;

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

  FPosition:= Value;

  if Playing then
  begin
    try
      FDSBuffer.Stop;

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

      FdspBufferPos:= FdspBufferSize;
      FWaveStream.Position:= FWritePosition;

      WriteWave(FDSBufferSize);

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


function TdspAudioStream.GetSize: Integer;
begin
 if Assigned(FWaveStream) then Result:= WaveStream.Size else Result:= 0;
end;


procedure TdspAudioStream.UpdatePlayedSize;
var PlayPosition, PlayedSize: DWORD;
begin
  PlayPosition:= FDSBuffer.Position;

  if FPlayBufferPos <= PlayPosition then PlayedSize:= PlayPosition - FPlayBufferPos
  else PlayedSize:= PlayPosition + (FDSBufferSize - FPlayBufferPos);

  Inc(FPlayedSize, PlayedSize);
  FPlayBufferPos:= PlayPosition;
end;


procedure TdspAudioStream.Play;
begin
  if not FPlaying then
  begin
    if FWaveStream = nil then raise Exception.Create(SWaveStreamNotSet);
    if Size = 0 then Exit;

    FPlaying:= True;
    try
      SetPosition(FPosition);
      FNotifyThread:= TdspAudioStreamNotify.Create(Self);
    except
      Stop;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -