dxsounds.pas

传奇源代码的delphi版本

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

  inherited Destroy;

  CloseHandle(FCapture.FNotifyEvent);
  FCapture.FNotifyThread := nil;

  if Assigned(FCapture.FOnFilledBuffer) then FCapture.Stop;
end;

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

procedure TSoundCaptureStreamNotify.Update;
begin
  if FCapture.FilledSize>0 then
  begin
    try
      FCapture.DoFilledBuffer;
    except
      on E: Exception do
      begin
        Application.HandleException(E);
        SetEvent(FCapture.FNotifyEvent);
      end;
    end;
  end;
end;

constructor TSoundCaptureStream.Create(GUID: PGUID);
const
  SamplesPerSecList: array[0..6] of Integer = (8000, 11025, 22050, 33075, 44100, 48000, 96000);
  BitsPerSampleList: array[0..3] of Integer = (8, 16, 24, 32);
  ChannelsList: array[0..1] of Integer = (1, 2);
var
  ASamplesPerSec, ABitsPerSample, AChannels: Integer;
  dscbd: TDSCBufferDesc;
  TempBuffer: IDirectSoundCaptureBuffer;
  Format: TWaveFormatEx;
begin
  inherited Create;
  FBufferLength := 1000;
  FSupportedFormats := TSoundCaptureFormats.Create;

  if DXDirectSoundCaptureCreate(GUID, FCapture, nil)<>DS_OK then
    raise ESoundCaptureStreamError.CreateFmt(SCannotInitialized, [SDirectSoundCapture]);

  {  The supported format list is acquired.  }
  for ASamplesPerSec:=Low(SamplesPerSecList) to High(SamplesPerSecList) do
    for ABitsPerSample:=Low(BitsPerSampleList) to High(BitsPerSampleList) do
      for AChannels:=Low(ChannelsList) to High(ChannelsList) do
      begin
        {  Test  }
        MakePCMWaveFormatEx(Format, SamplesPerSecList[ASamplesPerSec], BitsPerSampleList[ABitsPerSample], ChannelsList[AChannels]);

        FillChar(dscbd, SizeOf(dscbd), 0);
        dscbd.dwSize := SizeOf(dscbd);
        dscbd.dwBufferBytes := Format.nAvgBytesPerSec;
        dscbd.lpwfxFormat := @Format;

        {  If the buffer can be made,  the format of present can be used.  }
        if FCapture.CreateCaptureBuffer(dscbd, TempBuffer, nil)=DS_OK then
        begin
          TempBuffer := nil;
          with TSoundCaptureFormat.Create(FSupportedFormats) do
          begin
            FSamplesPerSec := Format.nSamplesPerSec;
            FBitsPerSample := Format.wBitsPerSample;
            FChannels := Format.nChannels;
          end;
        end;
      end;
end;

destructor TSoundCaptureStream.Destroy;
begin
  Stop;
  FSupportedFormats.Free;
  inherited Destroy;
end;

procedure TSoundCaptureStream.DoFilledBuffer;
begin
  if Assigned(FOnFilledBuffer) then FOnFilledBuffer(Self);
end;

class function TSoundCaptureStream.Drivers: TDirectXDrivers;
begin
  Result := EnumDirectSoundCaptureDrivers;
end;

function TSoundCaptureStream.GetFilledSize: Integer;
begin
  Result := GetReadSize;
end;

function TSoundCaptureStream.GetReadSize: Integer;
var
  CapturePosition, ReadPosition: DWORD;
begin
  if FBuffer.GetCurrentPosition(@DWORD(CapturePosition), @DWORD(ReadPosition))=DS_OK then
  begin
    if FBufferPos<=ReadPosition then
      Result := ReadPosition - FBufferPos
    else
      Result := FBufferSize - FBufferPos + ReadPosition;
  end else
    Result := 0;
end;

function TSoundCaptureStream.ReadWave(var Buffer; Count: Integer): Integer;
var
  Size: Integer;
  Data1, Data2: Pointer;
  Data1Size, Data2Size: DWORD;
  C: Byte;
begin
  if not FCapturing then
    Start;

  Result := 0;
  while Result<Count do
  begin
    Size := Min(Count-Result, GetReadSize);
    if Size>0 then
    begin
      if FBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, Data2Size, 0)=DS_OK then
      begin
        Move(Data1^, Pointer(Integer(@Buffer)+Result)^, Data1Size);
        Result := Result + Integer(Data1Size);

        if Data2<>nil then
        begin
          Move(Data2^, Pointer(Integer(@Buffer)+Result)^, Data2Size);
          Result := Result + Integer(Data1Size);
        end;

        FBuffer.UnLock(Data1, Data1Size, Data2, Data2Size);
        FBufferPos := (FBufferPos + Data1Size + Data2Size) mod FBufferSize;
      end else
        Break;
    end;
    if Result<Count then Sleep(50);
  end;

  case Format^.wBitsPerSample of
     8: C := $80;
    16: C := $00;
  else
    C := $00;
  end;

  FillChar(Pointer(Integer(@Buffer)+Result)^, Count-Result, C);
  Result := Count;
end;

procedure TSoundCaptureStream.SetBufferLength(Value: Integer);
begin
  FBufferLength := Max(Value, 0);
end;

procedure TSoundCaptureStream.SetOnFilledBuffer(Value: TNotifyEvent);
begin
  if CompareMem(@TMethod(FOnFilledBuffer), @TMethod(Value), SizeOf(TMethod)) then Exit;

  if FCapturing then
  begin
    if Assigned(FOnFilledBuffer) then
      FNotifyThread.Free;

    FOnFilledBuffer := Value;

    if Assigned(FOnFilledBuffer) then
    begin
      FNotifyThread := TSoundCaptureStreamNotify.Create(Self);
      FNotifyThread.Resume;
    end;
  end else
    FOnFilledBuffer := Value;
end;

procedure TSoundCaptureStream.Start;
var
  dscbd: TDSCBufferDesc;
begin
  Stop;
  try
    FCapturing := True;

    FormatSize := SizeOf(TWaveFormatEx);
    with FSupportedFormats[CaptureFormat] do
      MakePCMWaveFormatEx(Format^, SamplesPerSec, BitsPerSample, Channels);

    FBufferSize := Max(MulDiv(Format^.nAvgBytesPerSec, FBufferLength, 1000), 8000);

    FillChar(dscbd, SizeOf(dscbd), 0);
    dscbd.dwSize := SizeOf(dscbd);
    dscbd.dwBufferBytes := FBufferSize;
    dscbd.lpwfxFormat := Format;

    if FCapture.CreateCaptureBuffer(dscbd, FBuffer, nil)<>DS_OK then
      raise ESoundCaptureStreamError.CreateFmt(SCannotMade, [SDirectSoundCaptureBuffer]);

    FBufferPos := 0;

    FBuffer.Start(DSCBSTART_LOOPING);

    if Assigned(FOnFilledBuffer) then
    begin
      FNotifyThread := TSoundCaptureStreamNotify.Create(Self);
      FNotifyThread.Resume;
    end;
  except
    Stop;
    raise;
  end;
end;

procedure TSoundCaptureStream.Stop;
begin
  if FCapturing then
  begin
    FNotifyThread.Free;
    FCapturing := False;
    if FBuffer<>nil then
      FBuffer.Stop;
    FBuffer := nil;
  end;
end;

{  TSoundEngine  }

constructor TSoundEngine.Create(ADSound: TDirectSound);
begin
  inherited Create;
  FDSound := ADSound;
  FEnabled := True;


  FEffectList := TList.Create;
  FTimer := TTimer.Create(nil);
  FTimer.Interval := 500;
  FTimer.OnTimer := TimerEvent;
end;

destructor TSoundEngine.Destroy;
begin
  Clear;
  FTimer.Free;
  FEffectList.Free;
  inherited Destroy;
end;

procedure TSoundEngine.Clear;
var
  i: Integer;
begin
  for i:=EffectCount-1 downto 0 do
    Effects[i].Free;
  FEffectList.Clear;
end;

procedure TSoundEngine.EffectFile(const Filename: string; Loop, Wait: Boolean);
var
  Stream : TFileStream;
begin
  Stream :=TFileStream.Create(Filename, fmOpenRead);
  try
    EffectStream(Stream, Loop, Wait);
  finally
    Stream.Free;
  end;
end;

procedure TSoundEngine.EffectStream(Stream: TStream; Loop, Wait: Boolean);
var
  Wave: TWave;
begin
  Wave := TWave.Create;
  try
    Wave.LoadfromStream(Stream);
    EffectWave(Wave, Loop, Wait);
  finally
    Wave.Free;
  end;
end;

procedure TSoundEngine.EffectWave(Wave: TWave; Loop, Wait: Boolean);
var
  Buffer: TDirectSoundBuffer;
begin
  if not FEnabled then Exit;

  if Wait then
  begin
    Buffer := TDirectSoundBuffer.Create(FDSound);
    try
      Buffer.LoadFromWave(Wave);
      Buffer.Play(False);
      while Buffer.Playing do
        Sleep(1);
    finally
      Buffer.Free;
    end;
  end else
  begin
    Buffer := TDirectSoundBuffer.Create(FDSound);
    try
      Buffer.LoadFromWave(Wave);
      Buffer.Play(Loop);
    except
      Buffer.Free;
      raise;
    end;
    FEffectList.Add(Buffer);
  end;
end;

function TSoundEngine.GetEffect(Index: Integer): TDirectSoundBuffer;
begin
  Result := TDirectSoundBuffer(FEffectList[Index]);
end;

function TSoundEngine.GetEffectCount: Integer;
begin
  Result := FEffectList.Count;
end;

procedure TSoundEngine.SetEnabled(Value: Boolean);
var
  i: Integer;
begin
  for i:=EffectCount-1 downto 0 do
    Effects[i].Free;
  FEffectList.Clear;

  FEnabled := Value;
  FTimer.Enabled := Value;
end;

procedure TSoundEngine.TimerEvent(Sender: TObject);
var
  i: Integer;
begin
  for i:=EffectCount-1 downto 0 do
    if not TDirectSoundBuffer(FEffectList[i]).Playing then
    begin
      TDirectSoundBuffer(FEffectList[i]).Free;
      FEffectList.Delete(i);