dxsounds.pas

传奇源代码的delphi版本

begin
  {  IDirectSoundBuffer made.  }
  FillChar(BufferDesc, SizeOf(BufferDesc), 0);
 
  with BufferDesc do
  begin
    dwSize := SizeOf(TDSBufferDesc);
    dwFlags := DSBCAPS_CTRLDEFAULT;
    if DSound.FStickyFocus then
      dwFlags := dwFlags or DSBCAPS_STICKYFOCUS
    else if DSound.FGlobalFocus then
      dwFlags := dwFlags or DSBCAPS_GLOBALFOCUS;
    dwBufferBytes := Size;
    lpwfxFormat := @Format;
  end;

  if not CreateBuffer(BufferDesc) then
    raise EDirectSoundBufferError.CreateFmt(SCannotMade, [SDirectSoundBuffer]);
end;

procedure TDirectSoundBuffer.SetVolume(Value: Integer);
begin
  DXResult := IBuffer.SetVolume(Value);
end;

procedure TDirectSoundBuffer.Stop;
begin
  DXResult := IBuffer.Stop;
end;

procedure TDirectSoundBuffer.Unlock;
begin
  if IDSBuffer=nil then Exit;
  if FLockCount=0 then Exit;

  Dec(FLockCount);
  DXResult := IBuffer.UnLock(FLockAudioPtr1[FLockCount], FLockAudioSize1[FLockCount],
    FLockAudioPtr2[FLockCount], FLockAudioSize2[FLockCount]);
end;

{  TAudioStream  }

type
  TAudioStreamNotify = class(TThread)
  private
    FAudio: TAudioStream;
    FSleepTime: Integer;
    FStopOnTerminate: Boolean;
    constructor Create(Audio: TAudioStream);
    destructor Destroy; override;
    procedure Execute; override;
    procedure Update;
    procedure ThreadTerminate(Sender: TObject);
  end;

constructor TAudioStreamNotify.Create(Audio: TAudioStream);
begin
  FAudio := Audio;

  OnTerminate := ThreadTerminate;

  FAudio.FNotifyEvent := CreateEvent(nil, False, False, nil);
  FAudio.FNotifyThread := Self;

  FSleepTime := Min(FAudio.FBufferLength div 4, 1000 div 20);
  FStopOnTerminate := True;

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

destructor TAudioStreamNotify.Destroy;
begin
  FreeOnTerminate := False;

  SetEvent(FAudio.FNotifyEvent);
  inherited Destroy;
  CloseHandle(FAudio.FNotifyEvent);

  FAudio.FNotifyThread := nil;
end;

procedure TAudioStreamNotify.ThreadTerminate(Sender: TObject);
begin
  FAudio.FNotifyThread := nil;
  if FStopOnTerminate then FAudio.Stop;
end;

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

procedure TAudioStreamNotify.Update;
begin
  if not FAudio.Playing then
  begin
    SetEvent(FAudio.FNotifyEvent);
    EXit;
  end;

  try
    FAudio.Update2(True);
  except
    on E: Exception do
    begin
      Application.HandleException(E);
      SetEvent(FAudio.FNotifyEvent);
    end;
  end;
end;

constructor TAudioStream.Create(ADirectSound: TDirectSound);
begin
  inherited Create;
  FDSound := ADirectSound;
  FAutoUpdate := True;
  FBuffer := TDirectSoundBuffer.Create(FDSound);
  FBufferLength := 1000;
end;

destructor TAudioStream.Destroy;
begin
  Stop;
  WaveStream := nil;
  FBuffer.Free;
  inherited Destroy;
end;

function TAudioStream.GetFormat: PWaveFormatEX;
begin
  if WaveStream=nil then
    raise EAudioStreamError.Create(SWaveStreamNotSet);
  Result := WaveStream.Format;
end;

function TAudioStream.GetFormatSize: Integer;
begin
  if WaveStream=nil then
    raise EAudioStreamError.Create(SWaveStreamNotSet);
  Result := WaveStream.FormatSize;
end;

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;