mmdsmix.pas

一套及时通讯的原码

     property MaxContigFreeHWMemBytes: DWORD read FMaxContigFree write FLDummy stored False;
     property UnlockTransferRateHWBuffers: DWORD read FUnlockRate write FLDummy stored False;
     property PlayCPUOverheadSWBuffers: DWORD read FPlayCPU write FLDummy stored False;
  end;

  TMMDSBufferLostEvent = procedure(Sender: TObject; Buffer: TMMDSSoundBuffer; var Abort: Boolean) of object;
  TMMDSBufferEndEvent  = procedure(Sender: TObject; Buffer: TMMDSSoundBuffer) of object;

  {-- TMMDSWaveMixer ----------------------------------------------------}
  TMMDSWaveMixer = class(TMMNonVisualComponent)
  private
     DirectSoundObject: IDirectSound;
     FDevices         : TList;
     FDeviceID        : TMMDeviceID;
     FSampleRate      : Longint;        { sampling rate               }
     FBits            : TMMBits;        { bit8 or bit16               }
     FMode            : TMMMode;        { mMono, mStereo              }
     FProductName     : String;
     FPrimaryBuffer   : IDirectSoundBuffer;
     FBuffers         : TList;
     FLevel           : TMMDSLevel;
     FCaps            : TMMDSSoundCaps;
     FSpeakerConfig   : TMMDSSpeakerConfig;
     FVolume          : Longint;
     FPanning         : Longint;
     FMuted           : Boolean;
     FHandle          : THandle;
     FTimerInit       : integer;
     FUse3D           : Boolean;
     F3DListener      : TMMDS3DListener;
     FWorkInDesign    : Boolean;
     FCoopHandle      : THandle;

     FOnBufferLost    : TMMDSBufferLostEvent;
     FOnBufferEnd     : TMMDSBufferEndEvent;

     procedure SetPrimaryWaveFormat;
     procedure SetPCMWaveFormat(wf: TPCMWaveFormat);
     function  GetPCMWaveFormat: TPCMWaveFormat;
     procedure SetBits(aValue: TMMBits);
     procedure SetMode(aValue: TMMMode);
     procedure SetSampleRate(aValue: Longint);
     procedure SetCaps(aValue: TMMDSSoundCaps);
     function  GetCaps: TMMDSSoundCaps;
     procedure SetLevel(aValue: TMMDSLevel);
     function  GetNumDevs: integer;
     function  GetDevices(Index: integer): PDSDRIVERDESC;
     procedure SetDeviceID(DeviceID: TMMDeviceID);
     procedure SetProductName(aValue: String);
     function  GetBuffer(Index: integer): TMMDSSoundBuffer;
     function  GetBufferName(aName: string): TMMDSSoundBuffer;
     function  GetBufferCount: integer;
     function  GetSpeaker: TMMDSSpeakerConfig;
     procedure SetSpeaker(aValue: TMMDSSpeakerConfig);
     procedure SetMuted(aValue: Boolean);
     procedure SetVolume(aValue: Longint);
     function  GetVolume: Longint;
     procedure SetPanning(aValue: Longint);
     function  GetPanning: Longint;
     procedure CopyData(Buffer: TMMDSSoundBuffer);
     procedure UpdateTimer(Enable: Boolean);
     function  FindFreeName(aName: String): String;
     procedure SetUse3D(Value: Boolean);
     procedure Set3DListener(Value: TMMDS3DListener);
     function  GetOpened: Boolean;

  protected
     procedure WndProc(var Msg: TMessage); virtual;
     procedure BufferLost(Buffer: TMMDSSoundBuffer; Abort: Boolean); dynamic;
     procedure BufferEnd(Buffer: TMMDSSoundBuffer); dynamic;
     procedure Loaded; override;
  public
     constructor Create(AOwner: TComponent); override;
     destructor  Destroy; override;

     procedure Open;
     procedure Close;
     procedure CooperateWith(Handle: THandle);

     procedure CreateSoundBuffer(pwfx: PWaveFormatEx; dwLength: Longint; Buffer: TMMDSSoundBuffer; Static: Boolean);

     function  AddBuffer(var aName: string; aWave: TMMWave): TMMDSSoundBuffer;
     procedure SetupBuffer(var aName: string; aWave: TMMWave; Buffer: TMMDSSoundBuffer);
     function  DuplicateBuffer(var aName: string; Buffer: TMMDSSoundBuffer): TMMDSSoundBuffer;
     procedure ClearBuffer(Buffer: TMMDSSoundBuffer);
     procedure RemoveBuffer(Buffer: TMMDSSoundBuffer);
     procedure PlayBuffer(Buffer: TMMDSSoundBuffer);
     procedure PauseBuffer(Buffer: TMMDSSoundBuffer);
     procedure StopBuffer(Buffer: TMMDSSoundBuffer);
     procedure FreeBuffers;

     procedure OpenInDesignTime;
     procedure CloseInDesignTime;

     property  PCMWaveFormat: TPCMWaveFormat read GetPCMWaveFormat write SetPCMWaveFormat;
     property  Buffer[Index: integer]: TMMDSSoundBuffer read GetBuffer;
     property  BufferByName[aName: string]: TMMDSSoundBuffer read GetBufferName;
     property  BufferCount: integer read GetBufferCount;
     property  NumDevs: integer read GetNumDevs;
     property  Devices[Index: integer]: PDSDRIVERDESC read GetDevices;

     property  DirectSound: IDirectSound read DirectSoundObject;
     property  PrimaryBuffer: IDirectSoundBuffer read FPrimaryBuffer;

     property  Muted: Boolean read FMuted write SetMuted default False;
     property  Volume: Longint read GetVolume write SetVolume default 0;
     property  Panning: Longint read GetPanning write SetPanning default 0;
     property  Opened: Boolean read GetOpened;

  published
     property  OnBufferLost: TMMDSBufferLostEvent read FOnBufferLost write FOnBufferLost;
     property  OnBufferEnd: TMMDSBufferEndEvent read FOnBufferEnd write FOnBufferEnd;

     property  Level: TMMDSLevel read FLevel write SetLevel default prPriority;
     property  SoundCaps: TMMDSSoundCaps read GetCaps write SetCaps;
     property  SpeakerConfiguration: TMMDSSpeakerConfig read GetSpeaker write SetSpeaker default scStereo;
     property  DeviceID: TMMDeviceID read FDeviceID write SetDeviceID default 0;
     property  ProductName: String read FProductName write SetProductName stored False;
     property  BitLength: TMMBits read FBits write SetBits default b8bit;
     property  SampleRate: Longint read FSampleRate write SetSampleRate default 11025;
     property  Mode: TMMMode read FMode write SetMode default mMono;
     property  Use3D: Boolean read FUse3D write SetUse3D default False;
     property  Sound3D: TMMDS3DListener read F3DListener write Set3DListener;
  end;

  {-- TMMDSMixChannel ---------------------------------------------------}
  TMMDSMixChannel = class(TMMCustomMemoryWave)
  private
     FSoundBuffer   : TMMDSSoundBuffer;
     F3DBuffer      : TMMDS3DBuffer;
     FMixer         : TMMDSWaveMixer;
     FOnPlayEnd     : TNotifyEvent;

     procedure WaveChanged(Sender: TObject);
     procedure SetMuted(aValue: Boolean);
     function  GetMuted: Boolean;
     procedure SetVolume(aValue: Longint);
     function  GetVolume: Longint;
     procedure SetPanning(aValue: Longint);
     function  GetPanning: Longint;
     procedure SetFrequency(aValue: Longint);
     function  GetFrequency: Longint;
     procedure SetPosition(aValue: Longint);
     function  GetPosition: Longint;
     procedure SetLooping(aValue: Boolean);
     function  GetLooping: Boolean;
     function  GetPlaying: Boolean;
     function  GetPaused: Boolean;
     function  GetBufferLength: Longint;
     procedure BufferEnd(Sender: TObject);
     procedure BufferRelease(Sender: TObject);
     procedure Set3DBuffer(Value: TMMDS3DBuffer);
  protected
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
     procedure Loaded; override;
  public
     constructor Create(aOwner: TComponent); override;
     destructor  Destroy; override;

     procedure GetVUMeter(var LeftValue, RightValue, BothValue: integer; Interval: integer);

     procedure Init;
     procedure Play;
     procedure Pause;
     procedure Stop;

     property SoundBuffer: TMMDSSoundBuffer read FSoundBuffer;
     property BufferLength: Longint read GetBufferLength;
     property Position: Longint read GetPosition write SetPosition;

     property Playing: Boolean read GetPlaying;

     property Paused: Boolean read GetPaused;
     
  published
     property OnPlayEnd: TNotifyEvent read FOnPlayEnd write FOnPlayEnd;

     property Mixer: TMMDSWaveMixer read FMixer write FMixer;
     property Muted: Boolean read GetMuted write SetMuted default False;
     property Volume: Longint read GetVolume write SetVolume default 0;
     property Panning: Longint read GetPanning write SetPanning default 0;
     property Frequency: Longint read GetFrequency write SetFrequency default 0;
     property Looping: Boolean read GetLooping write SetLooping default False;

     property Sound3D: TMMDS3DBuffer read F3DBuffer write Set3DBuffer;
  end;

  {-- EDSMixError -------------------------------------------------------}
  EDSMixError       = class(Exception)
  end;

  {-- EDirectSoundError -------------------------------------------------}
  EDirectSoundError = class(EDSMixError)
  private
    FResult : HResult;
  public
    constructor CreateRes(Code: HResult);

    property Result: HResult read FResult;
  end;

procedure DSCheck(Res: HRESULT);
function  DSCheckExcl(Res: HRESULT; const Excl: array of HRESULT): HRESULT;

implementation

uses consts;

{------------------------------------------------------------------------}
function MM3DVectorToD3DVector(vec: TMM3DVector): TD3DVector;
begin
   with Result do
   begin
      X := vec.X;
      Y := vec.Y;
      Z := vec.Z;
   end;
end;

{------------------------------------------------------------------------}
function D3DVectorToMM3DVector(vec: TD3DVector): TMM3DVector;
begin
   with Result do
   begin
      X := vec.X;
      Y := vec.Y;
      Z := vec.Z;
   end;
end;

{== TMMDSSoundBuffer ====================================================}
constructor TMMDSSoundBuffer.Create;
begin
   inherited Create;

   DirectSoundBuffer := nil;
   FPlaying := False;
   FPaused := False;
   FLooping := False;
   FMuted := False;
   FVolume := 0;
   FPanning := 0;
   FFrequency := 0;
   FOnBufferEnd := nil;
end;

{-- TMMDSSoundBuffer ----------------------------------------------------}
function TMMDSSoundBuffer.GetCaps: TDSBCaps;
begin
   FillChar(Result, SizeOf(TDSBCAPS), 0);
   Result.dwSize := SizeOf(TDSBCAPS);
   if (DirectSoundBuffer <> nil) then DirectSoundBuffer.GetCaps(Result);
end;

{-- TMMDSSoundBuffer ----------------------------------------------------}
procedure TMMDSSoundBuffer.SetLooping(aValue: Boolean);
const
  LoopFlags: array[Boolean] of Integer = (0, DSBPLAY_LOOPING);
begin
   if (aValue <> FLooping) then
   begin
      FLooping := aValue;
      if Playing then
      begin
         DirectSoundBuffer.Play(0, 0, LoopFlags[FLooping]);
      end;
   end;
end;

{-- TMMDSSoundBuffer ----------------------------------------------------}
function TMMDSSoundBuffer.GetLooping: Boolean;
var
   aValue: DWORD;

begin
   if not Playing then Result := FLooping
   else
   begin
      DirectSoundBuffer.GetStatus(aValue);
      Result := (aValue and DSBSTATUS_LOOPING) > 0;
   end;
end;

{-- TMMDSSoundBuffer ----------------------------------------------------}
function TMMDSSoundBuffer.GetPlaying: Boolean;
var
  aResult: DWORD;

begin
   if (DirectSoundBuffer <> nil) then
   begin
      DirectSoundBuffer.GetStatus(aResult);
      Result := (aResult and DSBSTATUS_PLAYING) > 0;
   end
   else Result := False;
end;

{-- TMMDSSoundBuffer ----------------------------------------------------}
procedure TMMDSSoundBuffer.Play;
const
  LoopFlags: array[Boolean] of Integer = (0, DSBPLAY_LOOPING);
begin
   if Playing then Position := 0
   else if (DirectSoundBuffer <> nil) then
   begin
      DirectSoundBuffer.Play(0, 0, LoopFlags[FLooping]);
      FPlaying := True;
      FPaused := False;
   end;
end;

{-- TMMDSSoundBuffer ----------------------------------------------------}
procedure TMMDSSoundBuffer.Pause;
begin
   if (DirectSoundBuffer <> nil) then
   begin
      FPaused := True;
      DirectSoundBuffer.Stop;
   end;
end;

{-- TMMDSSoundBuffer ----------------------------------------------------}
procedure TMMDSSoundBuffer.Stop;
begin
   if (DirectSoundBuffer <> nil) then
   begin
      FPlaying := False;
      FPaused := False;
      DirectSoundBuffer.Stop;
      Position := 0;
   end;
end;

{-- TMMDSSoundBuffer ----------------------------------------------------}
procedure TMMDSSoundBuffer.ReleaseBuffer;
begin
    if DirectSoundBuffer <> nil then
    begin
        DirectSoundBuffer.Release;
        DirectSoundBuffer := nil;
        if Assigned(FOnRelease) then FOnRelease(Self);
    end;
end;

{-- TMMDSSoundBuffer ----------------------------------------------------}
procedure TMMDSSoundBuffer.FreeBuffer;
begin
    if DirectSoundBuffer <> nil then
        ReleaseBuffer;
    if not FOwned then Free;
end;

{-- TMMDSSoundBuffer ----------------------------------------------------}
procedure TMMDSSoundBuffer.SetMuted(aValue: Boolean);
var
   m: integer;
begin
   if (aValue <> FMuted) then
   begin
      if aValue then
      begin
         if (DirectSoundBuffer <> nil) then
         begin
            m := -10000;
            DirectSoundBuffer.SetVolume(m);
         end;
         FMuted := True;
      end
      else
      begin
         { restore the volume setting }
         if (DirectSoundBuffer <> nil) then
            DirectSoundBuffer.SetVolume(FVolume);
         FMuted := False;
      end;
   end;
end;

{-- TMMDSSoundBuffer ----------------------------------------------------}
procedure TMMDSSoundBuffer.SetVolume(aValue: Longint);
begin
   if (aValue <> FVolume) then
   begin
      FVolume := MinMax(aValue,-10000,0);
      if (DirectSoundBuffer <> nil) and not FMuted then
         DirectSoundBuffer.SetVolume(FVolume);
   end;
end;