mmdsmix.pas

一套及时通讯的原码

            DSCheck(DirectSoundObject.CreateSoundBuffer(BufferDesc, Buffer.DirectSoundBuffer, nil));
        end
        else
            { TODO: should be resource id }
            raise EDSMixError.Create('3D sound not available')
      else
      begin
          { ev. older DSound version which doesn't support DSBCAPS_STICKYFOCUS }
          BufferDesc.dwFlags := DSBCAPS_CTRLDEFAULT;
          if Static then
             BufferDesc.dwFlags := BufferDesc.dwFlags or DSBCAPS_STATIC;
          DSCheck(DirectSoundObject.CreateSoundBuffer(BufferDesc, Buffer.DirectSoundBuffer, nil));
      end;
   end;

   if Buffer.Muted then
   begin
      m := -10000;
      Buffer.DirectSoundBuffer.SetVolume(m);
   end
   else Buffer.DirectSoundBuffer.SetVolume(Buffer.FVolume);
   Buffer.DirectSoundBuffer.SetPan(Buffer.FPanning);
   Buffer.DirectSoundBuffer.SetFrequency(Buffer.FFrequency);
   FBuffers.Add(Buffer);
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.SetupBuffer(var aName: string; aWave: TMMWave; Buffer: TMMDSSoundBuffer);
Label Ready;
var
  pwfxSrc: PWaveFormatEx;
  wfx: TWaveFormatEx;
  BufSize: Longint;

begin
   if (Buffer = nil) then exit;

   if not aWave.IsMemWave then
      raise EMMDSWaveMixError.Create(LoadResStr(IDS_NOMEMWAVE));

   if (aWave.FormatTag <> WAVE_FORMAT_PCM) then
   begin
      if (aWave.FormatTag = WAVE_FORMAT_ADPCM) then
      begin
         pwfxSrc := aWave.PWaveFormat;
         if adpcmBuildFormatHeader(pwfxSrc, @wfx, 16, 0, 0) then
         begin
            BufSize := PADPCMWaveFormat(pwfxSrc)^.wSamplesPerBlock * Longint(wfx.nBlockAlign);
            BufSize := BufSize*(aWave.PWaveIOInfo^.dwDataBytes div pwfxSrc^.nBlockAlign);
            goto Ready;
         end;
      end;

      wfx := acmSuggestPCMFormat(aWave.PWaveFormat);

      if not acmQueryConvert(aWave.PWaveFormat,@wfx,False) then
         raise EMMDSWaveMixError.Create(LoadResStr(IDS_INVALIDFORMAT));

      BufSize := acmSizeOutputData(aWave.PWaveFormat,@wfx,aWave.PWaveIOInfo^.dwDataBytes);
   end
   else
   begin
      wfx     := aWave.PWaveFormat^;
      BufSize := aWave.PWaveIOInfo^.dwDataBytes;
   end;

Ready:

   with Buffer do
   begin
      aName := FindFreeName(aName);
      FName := aName;
      FWave := aWave;
   end;

   CreateSoundBuffer(@wfx, BufSize, Buffer, True);
   try
      CopyData(Buffer);
   except
      RemoveBuffer(Buffer);
   end;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
function TMMDSWaveMixer.AddBuffer(var aName: string; aWave: TMMWave): TMMDSSoundBuffer;
var
  Buffer: TMMDSSoundBuffer;

begin
   Buffer := TMMDSSoundBuffer.Create;
   try
      SetupBuffer(aName,aWave,Buffer);
   except
      Buffer.Free;
      raise;
   end;
   Result := Buffer;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.FreeBuffers;
begin
   while BufferCount > 0 do RemoveBuffer(Buffer[0]);
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.ClearBuffer(Buffer: TMMDSSoundBuffer);
var
  i: integer;

begin
   i := FBuffers.IndexOf(Buffer);
   if i >= 0 then
   begin
      StopBuffer(Buffer);
      Buffer.ReleaseBuffer;
      FBuffers.Delete(i);
      FBuffers.Pack;
   end;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.RemoveBuffer(Buffer: TMMDSSoundBuffer);
begin
   ClearBuffer(Buffer);
   Buffer.FreeBuffer;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
function TMMDSWaveMixer.DuplicateBuffer(var aName: string; Buffer: TMMDSSoundBuffer): TMMDSSoundBuffer;
var
  NewBuffer: TMMDSSoundBuffer;

begin
   Result := nil;
   if (Buffer = nil) or (Buffer.DirectSoundBuffer = nil) then exit;

   NewBuffer := TMMDSSoundBuffer.Create;
   aName := FindFreeName(aName);
   NewBuffer.FName := aName;
   NewBuffer.FWave := Buffer.Wave;

   if DirectSoundObject.DuplicateSoundBuffer(Buffer.DirectSoundBuffer, NewBuffer.DirectSoundBuffer) <> DS_OK then
   begin
      NewBuffer.Free;
      raise EMMDSWaveMixError.Create('DirectSound DuplicateSoundBuffer failed');
   end;

   if Buffer.Muted then
   begin
      NewBuffer.Volume := Buffer.FVolume;
      NewBuffer.Muted := Buffer.Muted;
   end
   else NewBuffer.Volume := Buffer.Volume;
   NewBuffer.Panning := Buffer.Panning;
   NewBuffer.Frequency := Buffer.Frequency;
   NewBuffer.Position := Buffer.Position;
   NewBuffer.Looping := Buffer.Looping;
   FBuffers.Add(NewBuffer);
   Result := NewBuffer;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.SetSpeaker(aValue: TMMDSSpeakerConfig);
begin
   FSpeakerConfig := aValue;
   if (DirectSoundObject <> nil) then
         DirectSoundObject.SetSpeakerConfig(Ord(aValue)+1);
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
function TMMDSWaveMixer.GetSpeaker: TMMDSSpeakerConfig;
var
  aResult: DWORD;

begin
   if (DirectSoundObject <> nil) then
   begin
      DirectSoundObject.GetSpeakerConfig(aResult);
      Result := TMMDSSpeakerConfig(aResult-1);
   end
   else Result := FSpeakerConfig;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.PlayBuffer(Buffer: TMMDSSoundBuffer);
var
  Status: DWORD;
  Abort : Boolean;

begin
   if (Buffer = nil) or (Buffer.DirectSoundBuffer = nil) then exit;

   Buffer.DirectSoundBuffer.GetStatus(Status);
   if (Status and DSBSTATUS_BUFFERLOST) > 0 then
   begin
      { Restore the buffer, rewrite data, and play }
      if Buffer.DirectSoundBuffer.Restore <> DS_OK then
         raise EMMDSWaveMixError.Create('DirectSoundBuffer restore failed');

      Abort := False;
      BufferLost(Buffer, Abort);

      if Abort then
      begin
         RemoveBuffer(Buffer);
         exit;
      end;
      CopyData(Buffer);
   end;

   if not Buffer.Playing and not Buffer.Paused then
   begin
      inc(FTimerInit);
      if (FTimerInit = 1) then UpdateTimer(True);
   end;

   Buffer.Play;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.PauseBuffer(Buffer: TMMDSSoundBuffer);
begin
   if (Buffer = nil) or (Buffer.DirectSoundBuffer = nil) then exit;

   Buffer.Pause;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.StopBuffer(Buffer: TMMDSSoundBuffer);
begin
   if (Buffer = nil) or (Buffer.DirectSoundBuffer = nil) then exit;

   if Buffer.Playing or Buffer.Paused then
   begin
      dec(FTimerInit);
      if (FTimerInit = 0) then UpdateTimer(False);
      Buffer.Stop;
      BufferEnd(Buffer);
   end
   else Buffer.Stop;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.OpenInDesignTime;
begin
    if not (csDesigning in ComponentState) then
        raise EMMDSWaveMixError.Create('OpenInDesignTime called in run-time');
    FWorkInDesign := True;
    Open;
    SetPrimaryWaveFormat;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.CloseInDesignTime;
begin
    if not (csDesigning in ComponentState) then
        raise EMMDSWaveMixError.Create('CloseInDesignTime called in run-time');
    Close;
    FWorkInDesign := False;
end;

{== TMMDSMixChannel =====================================================}
constructor TMMDSMixChannel.Create(aOwner: TComponent);
begin
   inherited Create(aOwner);

   FMixer := nil;

   if _WinNT3_ then
      raise EMMDSWaveMixError.Create(LoadResStr(IDS_DSNOTSUPPORTED));

   if not LoadDSoundDLL then
      raise EMMDSWaveMixError.Create(LoadResStr(IDS_DLLERROR)+' DSOUND.DLL...');

   FSoundBuffer := TMMDSSoundBuffer.Create;
   FSoundBuffer.FOnBufferEnd := BufferEnd;
   FSoundBuffer.FOnRelease   := BufferRelease;
   FSoundBuffer.FOwned       := True;
   Wave.OnChange := WaveChanged;

   F3DBuffer    := TMMDS3DBuffer.Create((aOwner <> nil) and (csLoading in aOwner.ComponentState));

   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;

{-- TMMDSMixChannel -----------------------------------------------------}
destructor TMMDSMixChannel.Destroy;
begin
   if FMixer <> nil then FMixer.Close;

   F3DBuffer.Free;

   inherited Destroy;
end;

{-- TMMDSMixChannel -----------------------------------------------------}
procedure   TMMDSMixChannel.Loaded;
begin
    inherited Loaded;
    with Sound3D do
        if MM3DVectorEqual(ConeOrientation.AsVector,ZeroVector) then
            ConeOrientation.AsVector := MM3DVector(defConeOrientX,defConeOrientY,defConeOrientZ);
end;

{-- TMMDSMixChannel -----------------------------------------------------}
procedure TMMDSMixChannel.Notification(AComponent: TComponent; Operation: TOperation);
begin
   inherited Notification(AComponent, Operation);

   if (Operation = opRemove) and (AComponent = FMixer) then FMixer := Nil;
end;

{-- TMMDSMixChannel -----------------------------------------------------}
procedure TMMDSMixChannel.WaveChanged(Sender: TObject);
begin
   if (FMixer <> nil) and (FSoundBuffer <> nil) then
   begin
      FMixer.ClearBuffer(FSoundBuffer);
   end;
end;

{-- TMMDSMixChannel -----------------------------------------------------}
procedure TMMDSMixChannel.Set3DBuffer(Value: TMMDS3DBuffer);
begin
    F3DBuffer.Assign(Value);
end;

{-- TMMDSMixChannel -----------------------------------------------------}
procedure TMMDSMixChannel.BufferEnd(Sender: TObject);
begin
   if (Sender = FSoundBuffer) then
   begin
      if assigned(FOnPlayEnd) then FOnPlayEnd(Self);
   end;
end;

{-- TMMDSMixChannel -----------------------------------------------------}
procedure TMMDSMixChannel.BufferRelease(Sender: TObject);
begin
    F3DBuffer.FreeBuffer;
end;

{-- TMMDSMixChannel -----------------------------------------------------}
procedure TMMDSMixChannel.Init;
var
   aName: String;

begin
   if (FMixer <> nil) and not Wave.Empty then
   with FMixer do
   begin
      if (FSoundBuffer.DirectSoundBuffer = nil) then
      begin
         FMixer.Open;
         aName := Wave.FileName;
         SetupBuffer(aName,Wave,FSoundBuffer);
         if Use3D then
            F3DBuffer.CreateBuffer(FSoundBuffer.DirectSoundBuffer);
      end;
   end;
end;

{-- TMMDSMixChannel -----------------------------------------------------}
procedure TMMDSMixChannel.Play;
begin
   Init;

   if (FMixer <> nil) then FMixer.PlayBuffer(FSoundBuffer);
end;

{-- TMMDSMixChannel -----------------------------------------------------}
procedure TMMDSMixChannel.Pause;
begin
   if (FMixer <> nil) then FMixer.PauseBuffer(FSoundBuffer);
end;

{-- TMMDSMixChannel -----------------------------------------------------}
procedure TMMDSMixChannel.Stop;
begin
   if (FMixer <> nil) then FMixer.StopBuffer(FSoundBuffer);
end;

{-- TMMDSMixChannel --