dxsounds.pas

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

  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(CapturePosition, 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);
    end;
end;

{  TCustomDXSound  }

type
  TDXSoundDirectSound = class(TDirectSound)
  private
    FDXSound: TCustomDXSound;
  protected
    procedure DoRestoreBuffer; override;
  end;

procedure TDXSoundDirectSound.DoRestoreBuffer;
begin
  inherited DoRestoreBuffer;
  FDXSound.Restore;
end;

constructor TCustomDXSound.Create(AOwner: TComponent);
begin
  FNotifyEventList := TList.Create;
  inherited Create(AOwner);
  FAutoInitialize := True;
  Options := [];
end;

destructor TCustomDXSound.Destroy;
begin
  Finalize;
  NotifyEventList(dsntDestroying);
  FNotifyEventList.Free;
  inherited Destroy;
end;

type
  PDXSoundNotifyEvent = ^TDXSoundNotifyEvent;

procedure TCustomDXSound.RegisterNotifyEvent(NotifyEvent: TDXSoundNotifyEvent);
var
  Event: PDXSoundNotifyEvent;
begin
  UnRegisterNotifyEvent(NotifyEvent);

  New(Event);
  Event^ := NotifyEvent;
  FNotifyEventList.Add(Event);

  if Initialized then
  begin
    NotifyEvent(Self, dsntInitialize);
    NotifyEvent(Self, dsntRestore);
  end;
end;

procedure TCustomDXSound.UnRegisterNotifyEvent(NotifyEvent: TDXSoundNotifyEvent);
var
  Event: PDXSoundNotifyEvent;
  i: Integer;
begin
  for i:=0 to FNotifyEventList.Count-1 do
  begin
    Event := FNotifyEventList[i];
    if (TMethod(Event^).Code = TMethod(NotifyEvent).Code) and
      (TMethod(Event^).Data = TMethod(NotifyEvent).Data) then
    begin
      Dispose(Event);
      FNotifyEventList.Delete(i);

      if Initialized then
        NotifyEvent(Self, dsntFinalize);

      Break;
    end;
  end;
end;

procedure TCustomDXSound.NotifyEventList(NotifyType: TDXSoundNotifyType);
var
  i: Integer;
begin
  for i:=FNotifyEventList.Count-1 downto 0 do
    PDXSoundNotifyEvent(FNotifyEventList[i])^(Self, NotifyType);
end;

procedure TCustomDXSound.FormWndProc(var Message: TMessage; DefWindowProc: TWndMethod);
begin
  case Message.Msg of
    WM_CREATE:
        begin
          DefWindowProc(Message);
          SetForm(FForm);
          Exit;
        end;
  end;
  DefWindowProc(Message);
end;

class function TCustomDXSound.Drivers: TDirectXDrivers;
begin
  Result := EnumDirectSoundDrivers;
end;

procedure TCustomDXSound.DoFinalize;
begin
  if Assigned(FOnFinalize) then FOnFinalize(Self);
end;

procedure TCustomDXSound.DoInitialize;
begin
  if Assigned(FOnInitialize) then FOnInitialize(Self);
end;

procedure TCustomDXSound.DoInitializing;
begin
  if Assigned(FOnInitializing) then FOnInitializing(Self);
end;

procedure TCustomDXSound.DoRestore;
begin
  if Assigned(FOnRestore) then FOnRestore(Self);
end;

procedure TCustomDXSound.Finalize;
begin
  if FInternalInitialized then
  begin
    try
      FSubClass.Free; FSubClass := nil;

      try
        if FCalledDoInitialize then
        begin
          FCalledDoInitialize := False;
          DoFinalize;
        end;
      finally
        NotifyEventList(dsntFinalize);
      end;
    finally
      FInitialized := False;
      FInternalInitialized := False;

      SetOptions(FOptions);

      FPrimary.Free; FPrimary := nil;
      FDSound.Free;  FDSound := nil;
    end;
  end;
end;

procedure TCustomDXSound.Initialize;
const
  PrimaryDesc: TDSBufferDesc = (
      dwSize: SizeOf (PrimaryDesc);
      dwFlags: DSBCAPS_PRIMARYBUFFER);
var
  Component: TComponent;
begin
  Finalize;

  Component := Owner;
  while (Component<>nil) and (not (Component is TCustomForm)) do
    Component := Component.Owner;
  if Component=nil then
    raise EDXSoundError.Create(SNoForm);